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

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