source: trunk/third/nautilus-cd-burner/intltool-update.in @ 21565

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