source: trunk/third/gal/xml-i18n-update.in @ 18133

Revision 18133, 15.9 KB checked in by ghudson, 22 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r18132, which included commits to RCS files with non-trunk default branches.
Line 
1#!@INTLTOOL_PERL@ -w
2
3#
4#  The Intltool Message Updater
5#
6#  Copyright (C) 2000-2002 Free Software Foundation.
7#
8#  Intltool is free software; you can redistribute it and/or
9#  modify it under the terms of the GNU General Public License
10#  version 2 published by the Free Software Foundation.
11#
12#  Intltool is distributed in the hope that it will be useful,
13#  but WITHOUT ANY WARRANTY; without even the implied warranty of
14#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15#  General Public License for more details.
16#
17#  You should have received a copy of the GNU General Public License
18#  along with this program; if not, write to the Free Software
19#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20#
21#  As a special exception to the GNU General Public License, if you
22#  distribute this file as part of a program that contains a
23#  configuration script generated by Autoconf, you may include it under
24#  the same distribution terms that you use for the rest of that program.
25#
26#  Authors: Kenneth Christiansen <kenneth@gnu.org>
27#           Maciej Stachowiak
28#           Darin Adler <darin@bentspoon.com>
29
30## Release information
31my $PROGRAM = "intltool-update";
32my $VERSION = "0.22";
33my $PACKAGE = "intltool";
34
35## Loaded modules
36use strict;
37use Getopt::Long;
38use Cwd;
39use File::Copy;
40use File::Find;
41
42## Scalars used by the option stuff
43my $HELP_ARG       = 0;
44my $VERSION_ARG    = 0;
45my $DIST_ARG       = 0;
46my $POT_ARG        = 0;
47my $HEADERS_ARG    = 0;
48my $MAINTAIN_ARG   = 0;
49my $REPORT_ARG     = 0;
50my $VERBOSE        = 0;
51my $GETTEXT_PACKAGE = "";
52
53my @languages;
54my %po_files_by_lang = ();
55
56# Regular expressions to categorize file types.
57# FIXME: Please check if the following is correct
58
59my $xml_extension =
60"xml(\.in)*|".          # .in is not required
61"ui|".
62"glade2?(\.in)*|".      # .in is not required
63"scm(\.in)*|".          # .in is not required
64"oaf(\.in)+|".
65"etspec|".
66"sheet(\.in)+|".
67"schemas(\.in)+|".
68"pong(\.in)+";
69
70my $ini_extension =
71"desktop(\.in)+|".
72"caves(\.in)+|".
73"directory(\.in)+|".
74"soundlist(\.in)+|".
75"keys(\.in)+|".
76"server(\.in)+";
77
78## Always print as the first thing
79$| = 1;
80
81## Handle options
82GetOptions
83(
84 "help"                => \$HELP_ARG,
85 "version"             => \$VERSION_ARG,
86 "dist|d"              => \$DIST_ARG,
87 "pot|p"               => \$POT_ARG,
88 "headers|s"           => \$HEADERS_ARG,
89 "maintain|m"          => \$MAINTAIN_ARG,
90 "report|r"            => \$REPORT_ARG,
91 "verbose|x"           => \$VERBOSE,
92 "gettext-package|g=s" => \$GETTEXT_PACKAGE,
93 ) or &print_error_invalid_option;
94
95&print_help if $HELP_ARG;
96&print_version if $VERSION_ARG;
97
98my $arg_count = ($DIST_ARG > 0)
99    + ($POT_ARG > 0)
100    + ($HEADERS_ARG > 0)
101    + ($MAINTAIN_ARG > 0)
102    + ($REPORT_ARG > 0);
103&print_help if $arg_count > 1;
104
105# --version and --help don't require a module name
106my $MODULE = $GETTEXT_PACKAGE || &find_package_name;
107
108if ($DIST_ARG) {
109    if ($ARGV[0] =~ /^[a-z]/){
110        &update_po_file ($ARGV[0]);
111        &print_status ($ARGV[0]);
112    } else {
113        &print_help;
114    }
115} elsif ($POT_ARG) {
116    &generate_headers;
117    &generate_po_template;
118} elsif ($HEADERS_ARG) {
119    &generate_headers;
120} elsif ($MAINTAIN_ARG) {
121    &find_leftout_files;
122} elsif ($REPORT_ARG) {
123    &print_report;
124} else {
125    if ($ARGV[0] =~ /^[a-z]/) {
126        &main ($ARGV[0]);
127    } else {
128        &print_help;
129    }
130}
131
132exit;
133
134#########
135
136sub print_version
137{
138    ## Print version information
139    print "${PROGRAM} (${PACKAGE}) $VERSION\n";
140    print "Written by Kenneth Christiansen, Maciej Stachowiak, and Darin Adler.\n\n";
141    print "Copyright (C) 2000-2002 Free Software Foundation, Inc.\n";
142    print "This is free software; see the source for copying conditions.  There is NO\n";
143    print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
144    exit;
145}
146
147sub print_help
148{
149    ## Print usage information
150    print "Usage: ${PROGRAM} [OPTIONS] ...LANGCODE\n";
151    print "Updates PO template files and merge them with the translations.\n\n";
152    print "  -p, --pot              generate the PO template only\n";
153    print "  -s, --headers          generate the header files in POTFILES.in\n";
154    print "  -m, --maintain         search for left out files from POTFILES.in\n";
155    print "  -r, --report           display a status report for the module.\n";
156    print "  -x, --verbose          display lots of feedback\n";
157    print "      --help             display this help and exit\n";
158    print "      --version          output version information and exit\n";
159    print "\nExamples of use:\n";
160    print "${PROGRAM} --pot    just creates a new PO template from the source\n";
161    print "${PROGRAM} da       created new PO template and updated the da.po file\n\n";
162    print "Report bugs to bugzilla.gnome.org, module 'intltool'.\n";
163    exit;
164}
165
166sub main
167{
168    my ($lang) = @_;
169
170    ## Report error if the language file supplied
171    ## to the command line is non-existent
172    &print_error_not_existing("$lang.po") if ! -s "$lang.po";
173
174    print "Working, please wait..." unless $VERBOSE;
175    &generate_headers;
176    &generate_po_template;
177    &update_po_file ($lang);
178    &print_status ($lang);
179}
180
181sub determine_type ($)
182{
183   my $type = $_;
184   my $gettext_type;
185
186   # FIXME: Use $xml_extentions, and maybe do all this even nicer
187   my $xml_regex =
188       "(?:xml(\.in)*|ui|oaf(?:\.in)+|server(?:\.in)+|sheet(?:\.in)+|".
189       "pong(?:\.in)+|etspec|schemas(?:\.in)+)";
190   my $ini_regex =
191       "(?:desktop(?:\.in)+|caves(?:\.in)+|directory(?:\.in)+|".
192       "soundlist(?:\.in)+)";
193
194   if ($type =~ /\[type: gettext\/([^\]].*)]/) {
195        $gettext_type=$1;
196   }
197   elsif ($type =~ /schemas(\.in)+$/) {
198        $gettext_type="schemas";
199   }
200   elsif ($type =~ /$xml_regex$/) {
201        $gettext_type="xml";
202   }
203   elsif ($type =~ /glade2?(\.in)*$/) {
204        $gettext_type="glade";
205   }
206   elsif ($type =~ /$ini_regex$/) {
207        $gettext_type="ini";
208   }
209   elsif ($type =~ /scm(\.in)*$/) {
210        $gettext_type="scheme";
211   }
212   elsif ($type =~ /keys(\.in)+$/) {
213        $gettext_type="keys";
214   }
215   else { $gettext_type=""; }
216
217   return "gettext\/$gettext_type";
218}
219
220sub find_leftout_files
221{
222    my (@buf_i18n_plain,
223        @buf_i18n_xml,
224        @buf_i18n_xml_unmarked,
225        @buf_i18n_ini,
226        @buf_potfiles,
227        @buf_potfiles_ignore,
228        @buf_allfiles,
229        @buf_allfiles_sorted,
230        @buf_potfiles_sorted
231    );
232
233    ## Search and find all translatable files
234    find sub {
235        push @buf_i18n_plain, "$File::Find::name" if /\.(c|y|cc|cpp|c\+\+|h|gob)$/
236        }, "..";
237    find sub {
238        push @buf_i18n_xml, "$File::Find::name" if /\.($xml_extension)$/
239        }, "..";
240    find sub {
241        push @buf_i18n_ini, "$File::Find::name" if /\.($ini_extension)$/
242        }, "..";
243    find sub {
244        push @buf_i18n_xml_unmarked, "$File::Find::name" if /\.(schemas(\.in)+)$/
245        }, "..";
246
247
248    open POTFILES, "POTFILES.in" or die "$PROGRAM:  there's no POTFILES.in!\n";
249
250    @buf_potfiles = grep /^[^#]/, <POTFILES>;
251                           
252    print "Searching for missing translatable files...\n" if $VERBOSE;
253
254    ## Check if we should ignore some found files, when
255    ## comparing with POTFILES.in
256    foreach my $ignore ("POTFILES.skip", "POTFILES.ignore") {
257        if (-s $ignore) {
258            open FILE, $ignore;
259            while (<FILE>) {
260                if (/^[^#]/){
261                    push @buf_potfiles_ignore, $_;
262                }
263            }
264            print "Found $ignore: Ignoring files...\n" if $VERBOSE;
265            @buf_potfiles = (@buf_potfiles_ignore, @buf_potfiles);
266        }
267    }
268
269    foreach my $file (@buf_i18n_plain)
270      {
271        my $in_comment = 0;
272        my $in_macro = 0;
273
274        open FILE, "<$file";
275        while (<FILE>)
276          {
277            # Handle continued multi-line comment.
278            if ($in_comment)
279              {
280                next unless s-.*\*/--;
281                $in_comment = 0;
282              }
283
284            # Handle continued macro.
285            if ($in_macro)
286              {
287                $in_macro = 0 unless /\\$/;
288                next;
289              }
290
291            # Handle start of macro (or any preprocessor directive).
292            if (/^\s*\#/)
293              {
294                $in_macro = 1 if /^([^\\]|\\.)*\\$/;
295                next;
296              }
297
298            # Handle comments and quoted text.
299            while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy
300              {
301                my $match = $1;
302                if ($match eq "/*")
303                  {
304                    if (!s-/\*.*?\*/--)
305                      {
306                        s-/\*.*--;
307                        $in_comment = 1;
308                      }
309                  }
310                elsif ($match eq "//")
311                  {
312                    s-//.*--;
313                  }
314                else # ' or "
315                  {
316                    if (!s-$match([^\\]|\\.)*?$match-QUOTEDTEXT-)
317                      {
318                        warn "mismatched quotes at line $. in $file\n";
319                        s-$match.*--;
320                      }
321                  }
322              }
323       
324
325            if (/_\(QUOTEDTEXT/)
326              {
327                ## Remove the first 3 chars and add newline
328                push @buf_allfiles, unpack("x3 A*", $file) . "\n";
329                last;
330              }
331          }
332        close FILE;
333      }
334
335    foreach my $file (@buf_i18n_xml) {
336        open FILE, "<$file";
337        while (<FILE>) {
338            if (/\s_(.*)=\"/ || /translatable=\"yes\"/){
339                push @buf_allfiles, unpack("x3 A*", $file) . "\n";
340                last;
341            }
342        }
343    }
344
345    foreach my $file (@buf_i18n_ini){
346        open FILE, "<$file";
347        while (<FILE>) {
348            if (/_(.*)=/){
349                push @buf_allfiles, unpack("x3 A*", $file) . "\n";
350                last;
351            }
352        }
353    }
354
355    foreach my $file (@buf_i18n_xml_unmarked){
356        push @buf_allfiles, unpack("x3 A*", $file) . "\n";
357    }
358
359
360    @buf_allfiles_sorted = sort (@buf_allfiles);
361    @buf_potfiles_sorted = sort (@buf_potfiles);
362
363    my %in2;
364    foreach (@buf_potfiles_sorted) {
365        $in2{$_} = 1;
366    }
367
368    my @result;
369
370    foreach (@buf_allfiles_sorted){
371        if (!exists($in2{$_})){
372            push @result, $_
373        }
374    }
375
376    ## Save file with information about the files missing
377    ## if any, and give information about this procedure.
378    if (@result) {
379        print "\n" if $VERBOSE;
380        open OUT, ">missing";
381        print OUT @result;
382        print "The following files contain translations and are currently not in use. Please\n";
383        print "consider adding these to the POTFILES.in file, located in the po/ directory.\n\n";
384        print @result, "\n";
385        print "If some of these files are left out on purpose then please add them to\n";
386        print "POTFILES.skip instead of POTFILES.in. A file 'missing' containing this list\n";
387        print "of left out files has been written in the current directory.\n";
388    }
389
390    ## If there is nothing to complain about, notify the user
391    else {
392        print "\nAll files containing translations are present in POTFILES.in.\n";
393    }
394}
395
396sub print_error_invalid_option
397{
398    ## Handle invalid arguments
399    print "Try `${PROGRAM} --help' for more information.\n";
400    exit 1;
401}
402
403sub generate_headers
404{
405    my $EXTRACT = `which intltool-extract 2>/dev/null`;
406    chomp $EXTRACT;
407
408    $EXTRACT = $ENV{"INTLTOOL_EXTRACT"} if $ENV{"INTLTOOL_EXTRACT"};
409
410    ## Generate the .h header files, so we can allow glade and
411    ## xml translation support
412    if (! -s $EXTRACT)
413    {
414        print "\n *** The intltool-extract script wasn't found!"
415             ."\n *** Without it, intltool-update can not generate files.\n";
416        exit;
417    }
418    else
419    {
420        open FILE, "<POTFILES.in";
421        while (<FILE>) {
422           chomp;
423
424           ## Find xml files in POTFILES.in and generate the
425           ## files with help from the extract script
426
427           my $gettext_type= &determine_type ($1);
428
429           if (/\.($xml_extension|$ini_extension)$/ || /^\[/){
430               $_ =~ s/^\[[^\[].*]\s*//;
431               my $filename = "../$_";
432
433               if ($VERBOSE){
434                   system($EXTRACT, "--update", "--type=$gettext_type", $filename);
435               } else {
436                   system($EXTRACT, "--update", "--type=$gettext_type", "--quiet", $filename);
437               }
438           }
439       }
440       close FILE;
441   }
442}
443
444sub generate_po_template
445{
446    ## Generate the potfiles from the POTFILES.in file
447
448    print "Building the $MODULE.pot...\n" if $VERBOSE;
449
450    move ("POTFILES.in", "POTFILES.in.old");
451
452    open INFILE, "<POTFILES.in.old";
453    open OUTFILE, ">POTFILES.in";
454    while (<INFILE>) {
455        s/\.($xml_extension|$ini_extension)$/$&.h/;
456        s/^\[.*]\s*(.*)/$1.h/;
457        print OUTFILE $_;
458    }
459    close OUTFILE;
460    close INFILE;
461
462    system ("xgettext", "--default-domain\=$MODULE",
463                        "--directory\=\.\.",
464                        "--add-comments",
465                        "--keyword\=\_",
466                        "--keyword\=N\_",
467                        "--keyword\=U\_",
468                        "--files-from\=\.\/POTFILES\.in");
469
470    move ("POTFILES.in.old", "POTFILES.in");
471
472    print "Removing generated header (.h) files..." if $VERBOSE;
473
474    open FILE, "<POTFILES.in";
475
476    while (<FILE>)
477    {
478        chomp;
479        unlink "../$_.h" if /\.($xml_extension|$ini_extension)$/;
480    }
481
482    close FILE;
483    print "done\n" if $VERBOSE;
484
485    if (!-e "$MODULE.po") {
486        print "WARNING: It seems that none of the files in POTFILES.in ".
487              "contain marked strings\n";
488        exit (1);
489    }
490
491    system ("rm", "-f", "$MODULE.pot");
492    move ("$MODULE.po", "$MODULE.pot") or die "$PROGRAM: couldn't move $MODULE.po to $MODULE.pot.\n";
493
494    print "Wrote $MODULE.pot\n" if $VERBOSE;
495}
496
497sub update_po_file
498{
499    my ($lang) = @_;
500
501    print "Merging $lang.po with $MODULE.pot..." if $VERBOSE;
502
503    copy ("$lang.po", "$lang.po.old") || die "copy failed: $!";
504
505    # Perform merge, remove backup file and the "messages" trash file
506    # generated by gettext
507    system ("msgmerge", "$lang.po.old", "$MODULE.pot", "-o", "$lang.po");
508    unlink "$lang.po.old";
509    unlink "messages";
510}
511
512sub print_error_not_existing
513{
514    my ($file) = @_;
515
516    ## Report error if supplied language file is non-existing
517    print "$PROGRAM: $file does not exist!\n";
518    print "Try '$PROGRAM --help' for more information.\n";
519    exit;
520}
521
522sub gather_po_files
523{
524    my @po_files = glob ("./*.po");
525
526    @languages = map (&po_file2lang, @po_files);
527
528    foreach my $lang (@languages) {
529        $po_files_by_lang{$lang} = shift (@po_files);
530    }
531}
532
533sub po_file2lang ($)
534{
535    my $tmp = $_;
536    $tmp =~ s/^.*\/(.*)\.po$/$1/;
537    return $tmp;
538}
539
540sub print_status
541{
542    my ($lang) = @_;
543
544    system ("msgfmt", "--statistics", "$lang.po");
545    print "\n";
546}
547
548sub print_report
549{
550    &generate_headers;
551    &generate_po_template;
552    &gather_po_files;
553
554    foreach my $lang (@languages) {
555        print "$lang: ";
556        &update_po_file ($lang);
557    }
558
559    print "\n\n * Current translation support in $MODULE \n\n";
560
561    foreach my $lang (@languages){
562        print "$lang: ";
563        system ("msgfmt", "--statistics", "$lang.po");
564    }
565}
566
567sub find_package_name
568{
569    my $base_dirname = getcwd();
570    $base_dirname =~ s@.*/@@;
571
572    my ($conf_in, $src_dir);
573
574    if ($base_dirname =~ /^po(-.+)?$/) {
575        if (-f "../configure.in") {
576            $conf_in = "../configure.in";
577        } elsif (-f "../configure.ac") {
578            $conf_in = "../configure.ac";
579        } else {
580            my $makefile_source;
581            local (*IN);
582            open IN, "<Makefile" || die "can't open Makefile: $!";
583
584            while (<IN>) {
585                if (/^top_srcdir[ \t]*=/) {
586                    $src_dir = $_;
587                    # print "${src_dir}\n";
588
589                    $src_dir =~ s/^top_srcdir[ \t]*=[ \t]*([^ \t\n\r]*)/$1/;
590                    # print "${src_dir}\n";
591                    chomp $src_dir;
592                    $conf_in = "$src_dir" . "/configure.in" . "\n";
593                    last;
594                }
595            }
596            $conf_in || die "Cannot find top_srcdir in Makefile."
597        }
598
599        my %varhash = ();
600        my $conf_source; {
601           local (*IN);
602           open (IN, "<$conf_in") || die "can't open $conf_in: $!";
603           while (<IN>) {
604              if (/^(\w+)=(\S+)/) { $varhash{$1} = $2 };
605           }
606           seek (IN, 0, 0);
607           local $/; # slurp mode
608           $conf_source = <IN>;
609        }
610
611        my $name = "";
612        $name = $1 if $conf_source =~ /^AM_INIT_AUTOMAKE\([\s\[]*([^,\)\s\]]+)/m;
613        if ($conf_source =~ /^AC_INIT\([\s\[]*([^,\)\s\]]+)\]?\s*,/m) {
614            $name = $1;
615            $varhash{"AC_PACKAGE_NAME"} = $1;
616        }
617        $name = $1 if $conf_source =~ /^GETTEXT_PACKAGE=\[?([^\s\]]+)/m;
618
619        $name = "\$AC_PACKAGE_NAME" if "$name" eq "AC_PACKAGE_NAME";
620
621        my $oldname = "";
622        while (($name =~ /[\$](\S+)/) && ("$oldname" ne "$name")) {
623            $oldname = $name;
624            if (exists $varhash{$1}) {
625                $name =~ s/[\$](\S+)/$varhash{$1}/;
626            }
627        }
628        return $name if $name;
629    }
630
631    print "$PROGRAM: Unable to determine package name.\n" .
632          "Make sure to run this script inside the po directory.\n";
633    exit;
634}
Note: See TracBrowser for help on using the repository browser.