source: trunk/third/xscreensaver/intltool-update.in @ 20148

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