source: trunk/third/gnome-terminal/intltool-update.in @ 21403

Revision 21403, 26.1 KB checked in by ghudson, 20 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r21402, which included commits to RCS files with non-trunk default branches.
Line 
1#!@INTLTOOL_PERL@ -w
2# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4  -*-
3
4#
5#  The Intltool Message Updater
6#
7#  Copyright (C) 2000-2003 Free Software Foundation.
8#
9#  Intltool is free software; you can redistribute it and/or
10#  modify it under the terms of the GNU General Public License
11#  version 2 published by the Free Software Foundation.
12#
13#  Intltool is distributed in the hope that it will be useful,
14#  but WITHOUT ANY WARRANTY; without even the implied warranty of
15#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16#  General Public License for more details.
17#
18#  You should have received a copy of the GNU General Public License
19#  along with this program; if not, write to the Free Software
20#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21#
22#  As a special exception to the GNU General Public License, if you
23#  distribute this file as part of a program that contains a
24#  configuration script generated by Autoconf, you may include it under
25#  the same distribution terms that you use for the rest of that program.
26#
27#  Authors: Kenneth Christiansen <kenneth@gnu.org>
28#           Maciej Stachowiak
29#           Darin Adler <darin@bentspoon.com>
30
31## Release information
32my $PROGRAM = "intltool-update";
33my $VERSION = "0.32.1";
34my $PACKAGE = "intltool";
35
36## Loaded modules
37use strict;
38use Getopt::Long;
39use Cwd;
40use File::Copy;
41use File::Find;
42
43## Scalars used by the option stuff
44my $HELP_ARG       = 0;
45my $VERSION_ARG    = 0;
46my $DIST_ARG       = 0;
47my $POT_ARG        = 0;
48my $HEADERS_ARG    = 0;
49my $MAINTAIN_ARG   = 0;
50my $REPORT_ARG     = 0;
51my $VERBOSE        = 0;
52my $GETTEXT_PACKAGE = "";
53my $OUTPUT_FILE    = "";
54
55my @languages;
56my %varhash = ();
57my %po_files_by_lang = ();
58
59# Regular expressions to categorize file types.
60# FIXME: Please check if the following is correct
61
62my $xml_support =
63"xml(?:\\.in)*|".       # http://www.w3.org/XML/ (Note: .in is not required)
64"ui|".                  # Bonobo specific - User Interface desc. files
65"lang|".                # ?
66"glade2?(?:\\.in)*|".   # Glade specific - User Interface desc. files (Note: .in is not required)
67"scm(?:\\.in)*|".       # ? (Note: .in is not required)
68"oaf(?:\\.in)+|".       # DEPRECATED: Replaces by Bonobo .server files
69"etspec|".              # ?
70"server(?:\\.in)+|".    # Bonobo specific
71"sheet(?:\\.in)+|".     # ?
72"schemas(?:\\.in)+|".   # GConf specific
73"pong(?:\\.in)+|".      # DEPRECATED: PONG is not used [by GNOME] any longer.
74"kbd(?:\\.in)+";        # GOK specific.
75
76my $ini_support =
77"icon(?:\\.in)+|".      # http://www.freedesktop.org/Standards/icon-theme-spec
78"desktop(?:\\.in)+|".   # http://www.freedesktop.org/Standards/menu-spec
79"caves(?:\\.in)+|".     # GNOME Games specific
80"directory(?:\\.in)+|". # http://www.freedesktop.org/Standards/menu-spec
81"soundlist(?:\\.in)+|". # GNOME specific
82"keys(?:\\.in)+|".      # GNOME Mime database specific
83"theme(?:\\.in)+";      # http://www.freedesktop.org/Standards/icon-theme-spec
84
85my $buildin_gettext_support =
86"c|y|cs|cc|cpp|c\\+\\+|h|hh|gob|py";
87
88## Always flush buffer when printing
89$| = 1;
90
91## Sometimes the source tree will be rooted somewhere else.
92my $SRCDIR = ".";
93my $POTFILES_in;
94
95$SRCDIR = $ENV{"srcdir"} if $ENV{"srcdir"};
96$POTFILES_in = "<$SRCDIR/POTFILES.in";
97
98## Handle options
99GetOptions
100(
101 "help"                => \$HELP_ARG,
102 "version"             => \$VERSION_ARG,
103 "dist|d"              => \$DIST_ARG,
104 "pot|p"               => \$POT_ARG,
105 "headers|s"           => \$HEADERS_ARG,
106 "maintain|m"          => \$MAINTAIN_ARG,
107 "report|r"            => \$REPORT_ARG,
108 "verbose|x"           => \$VERBOSE,
109 "gettext-package|g=s" => \$GETTEXT_PACKAGE,
110 "output-file|o=s"     => \$OUTPUT_FILE,
111 ) or &Console_WriteError_InvalidOption;
112
113&Console_Write_IntltoolHelp if $HELP_ARG;
114&Console_Write_IntltoolVersion if $VERSION_ARG;
115
116my $arg_count = ($DIST_ARG > 0)
117    + ($POT_ARG > 0)
118    + ($HEADERS_ARG > 0)
119    + ($MAINTAIN_ARG > 0)
120    + ($REPORT_ARG > 0);
121
122&Console_Write_IntltoolHelp if $arg_count > 1;
123
124# --version and --help don't require a module name
125my $MODULE = $GETTEXT_PACKAGE || &FindPackageName;
126
127if ($POT_ARG)
128{
129    &GenerateHeaders;
130    &GeneratePOTemplate;
131}
132elsif ($HEADERS_ARG)
133{
134    &GenerateHeaders;
135}
136elsif ($MAINTAIN_ARG)
137{
138    &FindLeftoutFiles;
139}
140elsif ($REPORT_ARG)
141{
142    &GenerateHeaders;
143    &GeneratePOTemplate;
144    &Console_Write_CoverageReport;
145}
146elsif ((defined $ARGV[0]) && $ARGV[0] =~ /^[a-z]/)
147{
148    my $lang = $ARGV[0];
149
150    ## Report error if the language file supplied
151    ## to the command line is non-existent
152    &Console_WriteError_NotExisting("$lang.po") if ! -s "$lang.po";
153
154    if (!$DIST_ARG)
155    {
156        print "Working, please wait..." if $VERBOSE;
157        &GenerateHeaders;
158        &GeneratePOTemplate;
159    }
160    &POFile_Update ($lang, $OUTPUT_FILE);
161    &Console_Write_TranslationStatus ($lang, $OUTPUT_FILE);
162}
163else
164{
165    &Console_Write_IntltoolHelp;
166}
167
168exit;
169
170#########
171
172sub Console_Write_IntltoolVersion
173{
174    print <<_EOF_;
175${PROGRAM} (${PACKAGE}) $VERSION
176Written by Kenneth Christiansen, Maciej Stachowiak, and Darin Adler.
177
178Copyright (C) 2000-2003 Free Software Foundation, Inc.
179This is free software; see the source for copying conditions.  There is NO
180warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
181_EOF_
182    exit;
183}
184
185sub Console_Write_IntltoolHelp
186{
187    print <<_EOF_;
188Usage: ${PROGRAM} [OPTION]... LANGCODE
189Updates PO template files and merge them with the translations.
190
191Mode of operation (only one is allowed):
192  -p, --pot                   generate the PO template only
193  -s, --headers               generate the header files in POTFILES.in
194  -m, --maintain              search for left out files from POTFILES.in
195  -r, --report                display a status report for the module
196  -d, --dist                  merge LANGCODE.po with existing PO template
197
198Extra options:
199  -g, --gettext-package=NAME  override PO template name, useful with --pot
200  -o, --output-file=FILE      write merged translation to FILE
201  -x, --verbose               display lots of feedback
202      --help                  display this help and exit
203      --version               output version information and exit
204
205Examples of use:
206${PROGRAM} --pot    just create a new PO template
207${PROGRAM} xy       create new PO template and merge xy.po with it
208
209Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE")
210or send email to <xml-i18n-tools\@gnome.org>.
211_EOF_
212    exit;
213}
214
215sub POFile_DetermineType ($)
216{
217   my $type = $_;
218   my $gettext_type;
219
220   my $xml_regex     = "(?:" . $xml_support . ")";
221   my $ini_regex     = "(?:" . $ini_support . ")";
222   my $buildin_regex = "(?:" . $buildin_gettext_support . ")";
223
224   if ($type =~ /\[type: gettext\/([^\]].*)]/)
225   {
226        $gettext_type=$1;
227   }
228   elsif ($type =~ /schemas(\.in)+$/)
229   {
230        $gettext_type="schemas";
231   }
232   elsif ($type =~ /glade2?(\.in)*$/)
233   {
234       $gettext_type="glade";
235   }
236   elsif ($type =~ /scm(\.in)*$/)
237   {
238       $gettext_type="scheme";
239   }
240   elsif ($type =~ /keys(\.in)+$/)
241   {
242       $gettext_type="keys";
243   }
244
245   # bucket types
246
247   elsif ($type =~ /$xml_regex$/)
248   {
249       $gettext_type="xml";
250   }
251   elsif ($type =~ /$ini_regex$/)
252   {
253       $gettext_type="ini";
254   }
255   elsif ($type =~ /$buildin_regex$/)
256   {
257       $gettext_type="buildin";
258   }
259   else
260   {
261       $gettext_type="unknown";
262   }
263
264   return "gettext\/$gettext_type";
265}
266
267sub TextFile_DetermineEncoding ($)
268{
269    my $gettext_code="ASCII"; # All files are ASCII by default
270    my $filetype=`file $_ | cut -d ' ' -f 2`;
271
272    if ($? eq "0")
273    {
274        if ($filetype =~ /^(ISO|UTF)/)
275        {
276            chomp ($gettext_code = $filetype);
277        }
278        elsif ($filetype =~ /^XML/)
279        {
280            $gettext_code="UTF-8"; # We asume that .glade and other .xml files are UTF-8
281        }
282    }
283
284    return $gettext_code;
285}
286
287sub isNotValidMissing
288{
289    my ($file) = @_;
290
291    return if $file =~ /^\{arch\}\/.*$/;
292    return if $file =~ /^$varhash{"PACKAGE"}-$varhash{"VERSION"}\/.*$/;
293}
294
295sub FindLeftoutFiles
296{
297    my (@buf_i18n_plain,
298        @buf_i18n_xml,
299        @buf_i18n_xml_unmarked,
300        @buf_i18n_ini,
301        @buf_potfiles,
302        @buf_potfiles_ignore,
303        @buf_allfiles,
304        @buf_allfiles_sorted,
305        @buf_potfiles_sorted
306    );
307
308    ## Search and find all translatable files
309    find sub {
310        push @buf_i18n_plain,        "$File::Find::name" if /\.($buildin_gettext_support)$/;
311        push @buf_i18n_xml,          "$File::Find::name" if /\.($xml_support)$/;
312        push @buf_i18n_ini,          "$File::Find::name" if /\.($ini_support)$/;
313        push @buf_i18n_xml_unmarked, "$File::Find::name" if /\.(schemas(\.in)+)$/;
314        }, "..";
315
316
317    open POTFILES, $POTFILES_in or die "$PROGRAM:  there's no POTFILES.in!\n";
318    @buf_potfiles = grep !/^(#|\s*$)/, <POTFILES>;
319    close POTFILES;
320
321    foreach (@buf_potfiles) {
322        s/^\[.*]\s*//;
323    }
324
325    print "Searching for missing translatable files...\n" if $VERBOSE;
326
327    ## Check if we should ignore some found files, when
328    ## comparing with POTFILES.in
329    foreach my $ignore ("POTFILES.skip", "POTFILES.ignore")
330    {
331        (-s $ignore) or next;
332
333        if ("$ignore" eq "POTFILES.ignore")
334        {
335            print "The usage of POTFILES.ignore is deprecated. Please consider moving the\n".
336                  "content of this file to POTFILES.skip.\n";
337        }
338
339        print "Found $ignore: Ignoring files...\n" if $VERBOSE;
340        open FILE, "<$ignore" or die "ERROR: Failed to open $ignore!\n";
341           
342        while (<FILE>)
343        {
344            push @buf_potfiles_ignore, $_ unless /^(#|\s*$)/;
345        }
346        close FILE;
347
348        @buf_potfiles = (@buf_potfiles_ignore, @buf_potfiles);
349    }
350
351    foreach my $file (@buf_i18n_plain)
352    {
353        my $in_comment = 0;
354        my $in_macro = 0;
355
356        open FILE, "<$file";
357        while (<FILE>)
358        {
359            # Handle continued multi-line comment.
360            if ($in_comment)
361            {
362                next unless s-.*\*/--;
363                $in_comment = 0;
364            }
365
366            # Handle continued macro.
367            if ($in_macro)
368            {
369                $in_macro = 0 unless /\\$/;
370                next;
371            }
372
373            # Handle start of macro (or any preprocessor directive).
374            if (/^\s*\#/)
375            {
376                $in_macro = 1 if /^([^\\]|\\.)*\\$/;
377                next;
378            }
379
380            # Handle comments and quoted text.
381            while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy
382            {
383                my $match = $1;
384                if ($match eq "/*")
385                {
386                    if (!s-/\*.*?\*/--)
387                    {
388                        s-/\*.*--;
389                        $in_comment = 1;
390                    }
391                }
392                elsif ($match eq "//")
393                {
394                    s-//.*--;
395                }
396                else # ' or "
397                {
398                    if (!s-$match([^\\]|\\.)*?$match-QUOTEDTEXT-)
399                    {
400                        warn "mismatched quotes at line $. in $file\n";
401                        s-$match.*--;
402                    }
403                }
404            }       
405
406            if (/\.GetString ?\(QUOTEDTEXT/)
407            {
408                if (defined isNotValidMissing (unpack("x3 A*", $file))) {
409                    ## Remove the first 3 chars and add newline
410                    push @buf_allfiles, unpack("x3 A*", $file) . "\n";
411                }
412                last;
413            }
414
415            if (/_\(QUOTEDTEXT/)
416            {
417                if (defined isNotValidMissing (unpack("x3 A*", $file))) {
418                    ## Remove the first 3 chars and add newline
419                    push @buf_allfiles, unpack("x3 A*", $file) . "\n";
420                }
421                last;
422            }
423        }
424        close FILE;
425    }
426
427    foreach my $file (@buf_i18n_xml)
428    {
429        open FILE, "<$file";
430       
431        while (<FILE>)
432        {
433            # FIXME: share the pattern matching code with intltool-extract
434            if (/\s_(.*)=\"/ || /<_[^>]+>/ || /translatable=\"yes\"/)
435            {
436                if (defined isNotValidMissing (unpack("x3 A*", $file))) {
437                    push @buf_allfiles, unpack("x3 A*", $file) . "\n";
438                }
439                last;
440            }
441        }
442        close FILE;
443    }
444
445    foreach my $file (@buf_i18n_ini)
446    {
447        open FILE, "<$file";
448        while (<FILE>)
449        {
450            if (/_(.*)=/)
451            {
452                if (defined isNotValidMissing (unpack("x3 A*", $file))) {
453                    push @buf_allfiles, unpack("x3 A*", $file) . "\n";
454                }
455                last;
456            }
457        }
458        close FILE;
459    }
460
461    foreach my $file (@buf_i18n_xml_unmarked)
462    {
463        if (defined isNotValidMissing (unpack("x3 A*", $file))) {
464            push @buf_allfiles, unpack("x3 A*", $file) . "\n";
465        }
466    }
467
468
469    @buf_allfiles_sorted = sort (@buf_allfiles);
470    @buf_potfiles_sorted = sort (@buf_potfiles);
471
472    my %in2;
473    foreach (@buf_potfiles_sorted)
474    {
475        $in2{$_} = 1;
476    }
477
478    my @result;
479
480    foreach (@buf_allfiles_sorted)
481    {
482        if (!exists($in2{$_}))
483        {
484            push @result, $_
485        }
486    }
487
488    my @buf_potfiles_notexist;
489
490    foreach (@buf_potfiles_sorted)
491    {
492        chomp (my $dummy = $_);
493        if ("$dummy" ne "" and ! -f "../$dummy")
494        {
495            push @buf_potfiles_notexist, $_;
496        }
497    }
498
499    ## Save file with information about the files missing
500    ## if any, and give information about this procedure.
501    if (@result + @buf_potfiles_notexist > 0)
502    {
503        if (@result)
504        {
505            print "\n" if $VERBOSE;
506            unlink "missing";
507            open OUT, ">missing";
508            print OUT @result;
509            close OUT;
510            warn "\e[1mThe following files contain translations and are currently not in use. Please\e[0m\n".
511                 "\e[1mconsider adding these to the POTFILES.in file, located in the po/ directory.\e[0m\n\n";
512            print STDERR @result, "\n";
513            warn "If some of these files are left out on purpose then please add them to\n".
514                 "POTFILES.skip instead of POTFILES.in. A file \e[1m'missing'\e[0m containing this list\n".
515                 "of left out files has been written in the current directory.\n";
516        }
517        if (@buf_potfiles_notexist)
518        {
519            unlink "notexist";
520            open OUT, ">notexist";
521            print OUT @buf_potfiles_notexist;
522            close OUT;
523            warn "\n" if ($VERBOSE or @result);
524            warn "\e[1mThe following files do not exist anymore:\e[0m\n\n";
525            warn @buf_potfiles_notexist, "\n";
526            warn "Please remove them from POTFILES.in or POTFILES.skip. A file \e[1m'notexist'\e[0m\n".
527                 "containing this list of absent files has been written in the current directory.\n";
528        }
529    }
530
531    ## If there is nothing to complain about, notify the user
532    else {
533        print "\nAll files containing translations are present in POTFILES.in.\n" if $VERBOSE;
534    }
535}
536
537sub Console_WriteError_InvalidOption
538{
539    ## Handle invalid arguments
540    print STDERR "Try `${PROGRAM} --help' for more information.\n";
541    exit 1;
542}
543
544sub GenerateHeaders
545{
546    my $EXTRACT = "@INTLTOOL_EXTRACT@";
547    chomp $EXTRACT;
548
549    $EXTRACT = $ENV{"INTLTOOL_EXTRACT"} if $ENV{"INTLTOOL_EXTRACT"};
550
551    ## Generate the .h header files, so we can allow glade and
552    ## xml translation support
553    if (! -x "$EXTRACT")
554    {
555        print STDERR "\n *** The intltool-extract script wasn't found!"
556             ."\n *** Without it, intltool-update can not generate files.\n";
557        exit;
558    }
559    else
560    {
561        open (FILE, $POTFILES_in) or die "$PROGRAM: POTFILES.in not found.\n";
562       
563        while (<FILE>)
564        {
565           chomp;
566           next if /^\[\s*encoding/;
567
568           ## Find xml files in POTFILES.in and generate the
569           ## files with help from the extract script
570
571           my $gettext_type= &POFile_DetermineType ($1);
572
573           if (/\.($xml_support|$ini_support)$/ || /^\[/)
574           {
575               s/^\[[^\[].*]\s*//;
576
577               my $filename = "../$_";
578
579               if ($VERBOSE)
580               {
581                   system ($EXTRACT, "--update", "--srcdir=$SRCDIR",
582                           "--type=$gettext_type", $filename);
583               }
584               else
585               {
586                   system ($EXTRACT, "--update", "--type=$gettext_type",
587                           "--srcdir=$SRCDIR", "--quiet", $filename);
588               }
589           }
590       }
591       close FILE;
592   }
593}
594
595#
596# Generate .pot file from POTFILES.in
597#
598sub GeneratePOTemplate
599{
600    my $XGETTEXT = $ENV{"XGETTEXT"} || "/usr/bin/xgettext";
601    my $XGETTEXT_ARGS = $ENV{"XGETTEXT_ARGS"} || '';
602    chomp $XGETTEXT;
603
604    if (! -x $XGETTEXT)
605    {
606        print STDERR " *** xgettext is not found on this system!\n".
607                     " *** Without it, intltool-update can not extract strings.\n";
608        exit;
609    }
610
611    print "Building $MODULE.pot...\n" if $VERBOSE;
612
613    open INFILE, $POTFILES_in;
614    unlink "POTFILES.in.temp";
615    open OUTFILE, ">POTFILES.in.temp" or die("Cannot open POTFILES.in.temp for writing");
616
617    my $gettext_support_nonascii = 0;
618
619    # checks for GNU gettext >= 0.12
620    my $dummy = `$XGETTEXT --version --from-code=UTF-8 >/dev/null 2>/dev/null`;
621    if ($? == 0)
622    {
623        $gettext_support_nonascii = 1;
624    }
625    else
626    {
627        # urge everybody to upgrade gettext
628        print STDERR "WARNING: This version of gettext does not support extracting non-ASCII\n".
629                     "         strings. That means you should install a version of gettext\n".
630                     "         that supports non-ASCII strings (such as GNU gettext >= 0.12),\n".
631                     "         or have to let non-ASCII strings untranslated. (If there is any)\n";
632    }
633
634    my $encoding = "ASCII";
635    my $forced_gettext_code;
636    my @temp_headers;
637    my $encoding_problem_is_reported = 0;
638
639    while (<INFILE>)
640    {
641        next if (/^#/ or /^\s*$/);
642
643        chomp;
644
645        my $gettext_code;
646
647        if (/^\[\s*encoding:\s*(.*)\s*\]/)
648        {
649            $forced_gettext_code=$1;
650        }
651        elsif (/\.($xml_support|$ini_support)$/ || /^\[/)
652        {
653            s/^\[.*]\s*//;
654            print OUTFILE "$_.h\n";
655            push @temp_headers, "../$_.h";
656            $gettext_code = &TextFile_DetermineEncoding ("../$_.h") if ($gettext_support_nonascii and not defined $forced_gettext_code);
657        }
658        else
659        {
660            if ($SRCDIR eq ".") {
661                print OUTFILE "$_\n";
662            } else {
663                print OUTFILE "$SRCDIR/../$_\n";
664            }
665            $gettext_code = &TextFile_DetermineEncoding ("../$_") if ($gettext_support_nonascii and not defined $forced_gettext_code);
666        }
667
668        next if (! $gettext_support_nonascii);
669
670        if (defined $forced_gettext_code)
671        {
672            $encoding=$forced_gettext_code;
673        }
674        elsif (defined $gettext_code and "$encoding" ne "$gettext_code")
675        {
676            if ($encoding eq "ASCII")
677            {
678                $encoding=$gettext_code;
679            }
680            elsif ($gettext_code ne "ASCII")
681            {
682                # Only report once because the message is quite long
683                if (! $encoding_problem_is_reported)
684                {
685                    print STDERR "WARNING: You should use the same file encoding for all your project files,\n".
686                                 "         but $PROGRAM thinks that most of the source files are in\n".
687                                 "         $encoding encoding, while \"$_\" is (likely) in\n".
688                                 "         $gettext_code encoding. If you are sure that all translatable strings\n".
689                                 "         are in same encoding (say UTF-8), please \e[1m*prepend*\e[0m the following\n".
690                                 "         line to POTFILES.in:\n\n".
691                                 "                 [encoding: UTF-8]\n\n".
692                                 "         and make sure that configure.in/ac checks for $PACKAGE >= 0.27 .\n".
693                                 "(such warning message will only be reported once.)\n";
694                    $encoding_problem_is_reported = 1;
695                }
696            }
697        }
698    }
699
700    close OUTFILE;
701    close INFILE;
702
703    unlink "$MODULE.pot";
704    my @xgettext_argument=("$XGETTEXT",
705                           "--add-comments",
706                           "--directory\=\.\.",
707                           "--output\=$MODULE\.pot",
708                           "--files-from\=\.\/POTFILES\.in\.temp");
709    my $XGETTEXT_KEYWORDS = &FindPOTKeywords;
710    push @xgettext_argument, $XGETTEXT_KEYWORDS;
711    push @xgettext_argument, "--from-code\=$encoding" if ($gettext_support_nonascii);
712    push @xgettext_argument, $XGETTEXT_ARGS if $XGETTEXT_ARGS;
713    my $xgettext_command = join ' ', @xgettext_argument;
714
715    # intercept xgettext error message
716    print "Running $xgettext_command\n" if $VERBOSE;
717    my $xgettext_error_msg = `$xgettext_command 2>\&1`;
718    my $command_failed = $?;
719
720    unlink "POTFILES.in.temp";
721
722    print "Removing generated header (.h) files..." if $VERBOSE;
723    unlink foreach (@temp_headers);
724    print "done.\n" if $VERBOSE;
725
726    if (! $command_failed)
727    {
728        if (! -e "$MODULE.pot")
729        {
730            print "None of the files in POTFILES.in contain strings marked for translation.\n" if $VERBOSE;
731        }
732        else
733        {
734            print "Wrote $MODULE.pot\n" if $VERBOSE;
735        }
736    }
737    else
738    {
739        if ($xgettext_error_msg =~ /--from-code/)
740        {
741            # replace non-ASCII error message with a more useful one.
742            print STDERR "ERROR: xgettext failed to generate PO template file because there is non-ASCII\n".
743                         "       string marked for translation. Please make sure that all strings marked\n".
744                         "       for translation are in uniform encoding (say UTF-8), then \e[1m*prepend*\e[0m the\n".
745                         "       following line to POTFILES.in and rerun $PROGRAM:\n\n".
746                         "           [encoding: UTF-8]\n\n";
747        }
748        else
749        {
750            print STDERR "$xgettext_error_msg";
751            if (-e "$MODULE.pot")
752            {
753                # is this possible?
754                print STDERR "ERROR: xgettext failed but still managed to generate PO template file.\n".
755                             "       Please consult error message above if there is any.\n";
756            }
757            else
758            {
759                print STDERR "ERROR: xgettext failed to generate PO template file. Please consult\n".
760                             "       error message above if there is any.\n";
761            }
762        }
763        exit (1);
764    }
765}
766
767sub POFile_Update
768{
769    -f "$MODULE.pot" or die "$PROGRAM: $MODULE.pot does not exist.\n";
770
771    my $MSGMERGE = $ENV{"MSGMERGE"} || "/usr/bin/msgmerge";
772    my ($lang, $outfile) = @_;
773
774    print "Merging $lang.po with $MODULE.pot..." if $VERBOSE;
775
776    my $infile = "$lang.po";
777    $outfile = "$lang.po" if ($outfile eq "");
778
779    # I think msgmerge won't overwrite old file if merge is not successful
780    system ("$MSGMERGE", "-o", $outfile, $infile, "$MODULE.pot");
781}
782
783sub Console_WriteError_NotExisting
784{
785    my ($file) = @_;
786
787    ## Report error if supplied language file is non-existing
788    print STDERR "$PROGRAM: $file does not exist!\n";
789    print STDERR "Try '$PROGRAM --help' for more information.\n";
790    exit;
791}
792
793sub GatherPOFiles
794{
795    my @po_files = glob ("./*.po");
796
797    @languages = map (&POFile_GetLanguage, @po_files);
798
799    foreach my $lang (@languages)
800    {
801        $po_files_by_lang{$lang} = shift (@po_files);
802    }
803}
804
805sub POFile_GetLanguage ($)
806{
807    s/^(.*\/)?(.+)\.po$/$2/;
808    return $_;
809}
810
811sub Console_Write_TranslationStatus
812{
813    my ($lang, $output_file) = @_;
814    my $MSGFMT = $ENV{"MSGFMT"} || "/usr/bin/msgfmt";
815
816    $output_file = "$lang.po" if ($output_file eq "");
817
818    system ("$MSGFMT", "-o", "/dev/null", "--statistics", $output_file);
819}
820
821sub Console_Write_CoverageReport
822{
823    my $MSGFMT = $ENV{"MSGFMT"} || "/usr/bin/msgfmt";
824
825    &GatherPOFiles;
826
827    foreach my $lang (@languages)
828    {
829        print "$lang: ";
830        &POFile_Update ($lang, "");
831    }
832
833    print "\n\n * Current translation support in $MODULE \n\n";
834
835    foreach my $lang (@languages)
836    {
837        print "$lang: ";
838        system ("$MSGFMT", "-o", "/dev/null", "--statistics", "$lang.po");
839    }
840}
841
842sub SubstituteVariable
843{
844    my ($str) = @_;
845   
846    # always need to rewind file whenever it has been accessed
847    seek (CONF, 0, 0);
848
849    # cache each variable. varhash is global to we can add
850    # variables elsewhere.
851    while (<CONF>)
852    {
853        if (/^(\w+)=(.*)$/)
854        {
855            ($varhash{$1} = $2) =~  s/^["'](.*)["']$/$1/;
856        }
857    }
858   
859    if ($str =~ /^(.*)\${?([A-Z_]+)}?(.*)$/)
860    {
861        my $rest = $3;
862        my $untouched = $1;
863        my $sub = $varhash{$2};
864       
865        return SubstituteVariable ("$untouched$sub$rest");
866    }
867   
868    # We're using Perl backticks ` and "echo -n" here in order to
869    # expand any shell escapes (such as backticks themselves) in every variable
870    return `echo -n "$str"`;
871}
872
873sub CONF_Handle_Open
874{
875    my $base_dirname = getcwd();
876    $base_dirname =~ s@.*/@@;
877
878    my ($conf_in, $src_dir);
879
880    if ($base_dirname =~ /^po(-.+)?$/)
881    {
882        if (-f "Makevars")
883        {
884            my $makefile_source;
885
886            local (*IN);
887            open (IN, "<Makevars") || die "can't open Makevars: $!";
888
889            while (<IN>)
890            {
891                if (/^top_builddir[ \t]*=/)
892                {
893                    $src_dir = $_;
894                    $src_dir =~ s/^top_builddir[ \t]*=[ \t]*([^ \t\n\r]*)/$1/;
895
896                    chomp $src_dir;
897                    if (-f "$src_dir" . "/configure.ac") {
898                        $conf_in = "$src_dir" . "/configure.ac" . "\n";
899                    } else {
900                        $conf_in = "$src_dir" . "/configure.in" . "\n";
901                    }
902                    last;
903                }
904            }
905            close IN;
906
907            $conf_in || die "Cannot find top_builddir in Makevars.";
908        }
909        elsif (-f "../configure.ac")
910        {
911            $conf_in = "../configure.ac";
912        }
913        elsif (-f "../configure.in")
914        {
915            $conf_in = "../configure.in";
916        }
917        else
918        {
919            my $makefile_source;
920
921            local (*IN);
922            open (IN, "<Makefile") || return;
923
924            while (<IN>)
925            {
926                if (/^top_srcdir[ \t]*=/)
927                {
928                    $src_dir = $_;                 
929                    $src_dir =~ s/^top_srcdir[ \t]*=[ \t]*([^ \t\n\r]*)/$1/;
930
931                    chomp $src_dir;
932                    $conf_in = "$src_dir" . "/configure.in" . "\n";
933
934                    last;
935                }
936            }
937            close IN;
938
939            $conf_in || die "Cannot find top_srcdir in Makefile.";
940        }
941
942        open (CONF, "<$conf_in");
943    }
944    else
945    {
946        print STDERR "$PROGRAM: Unable to proceed.\n" .
947                     "Make sure to run this script inside the po directory.\n";
948        exit;
949    }
950}
951
952sub FindPackageName
953{
954    my $version;
955    my $domain = &FindMakevarsDomain;
956    my $name = $domain || "untitled";
957
958    &CONF_Handle_Open;
959
960    my $conf_source; {
961        local (*IN);
962        open (IN, "<&CONF") || return $name;
963        seek (IN, 0, 0);
964        local $/; # slurp mode
965        $conf_source = <IN>;
966        close IN;
967    }
968
969    # priority for getting package name:
970    # 1. GETTEXT_PACKAGE
971    # 2. first argument of AC_INIT (with >= 2 arguments)
972    # 3. first argument of AM_INIT_AUTOMAKE (with >= 2 argument)
973
974    # /^AM_INIT_AUTOMAKE\([\s\[]*([^,\)\s\]]+)/m
975    # the \s makes this not work, why?
976    if ($conf_source =~ /^AM_INIT_AUTOMAKE\(([^,\)]+),([^,\)]+)/m)
977    {
978        ($name, $version) = ($1, $2);
979        $name    =~ s/[\[\]\s]//g;
980        $version =~ s/[\[\]\s]//g;
981        $varhash{"AC_PACKAGE_NAME"} = $name;
982        $varhash{"PACKAGE"} = $name;
983        $varhash{"AC_PACKAGE_VERSION"} = $version;
984        $varhash{"VERSION"} = $version;
985    }
986   
987    if ($conf_source =~ /^AC_INIT\(([^,\)]+),([^,\)]+)/m)
988    {
989        ($name, $version) = ($1, $2);
990        $name    =~ s/[\[\]\s]//g;
991        $version =~ s/[\[\]\s]//g;
992        $varhash{"AC_PACKAGE_NAME"} = $name;
993        $varhash{"PACKAGE"} = $name;
994        $varhash{"AC_PACKAGE_VERSION"} = $version;
995        $varhash{"VERSION"} = $version;
996    }
997
998    # \s makes this not work, why?
999    $name = $1 if $conf_source =~ /^GETTEXT_PACKAGE=\[?([^\n\]]+)/m;
1000   
1001    # prepend '$' to auto* internal variables, usually they are
1002    # used in configure.in/ac without the '$'
1003    $name =~ s/AC_/\$AC_/g;
1004    $name =~ s/\$\$/\$/g;
1005
1006    $name = $domain if $domain;
1007
1008    $name = SubstituteVariable ($name);
1009    $name =~ s/^["'](.*)["']$/$1/;
1010
1011    return $name if $name;
1012}
1013
1014
1015sub FindPOTKeywords
1016{
1017
1018    my $keywords = "--keyword\=\_ --keyword\=N\_ --keyword\=U\_ --keyword\=Q\_";
1019    my $varname = "XGETTEXT_OPTIONS";
1020    my $make_source; {
1021        local (*IN);
1022        open (IN, "<Makevars") || (open(IN, "<Makefile.in.in") && ($varname = "XGETTEXT_KEYWORDS")) || return $keywords;
1023        seek (IN, 0, 0);
1024        local $/; # slurp mode
1025        $make_source = <IN>;
1026        close IN;
1027    }
1028
1029    $keywords = $1 if $make_source =~ /^$varname[ ]*=\[?([^\n\]]+)/m;
1030   
1031    return $keywords;
1032}
1033
1034sub FindMakevarsDomain
1035{
1036
1037    my $domain = "";
1038    my $makevars_source; {
1039        local (*IN);
1040        open (IN, "<Makevars") || return $domain;
1041        seek (IN, 0, 0);
1042        local $/; # slurp mode
1043        $makevars_source = <IN>;
1044        close IN;
1045    }
1046
1047    $domain = $1 if $makevars_source =~ /^DOMAIN[ ]*=\[?([^\n\]\$]+)/m;
1048    $domain =~ s/^\s+//;
1049    $domain =~ s/\s+$//;
1050   
1051    return $domain;
1052}
Note: See TracBrowser for help on using the repository browser.