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