source: trunk/third/evolution-data-server/intltool-update.in @ 21189

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