intltool-update

   1 #!/usr/bin/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.36.2";
  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/..";
 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             ## N_ Q_ and _ are the three macros defined in gi8n.h
 438             if (/[NQ]?_ *\(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     $keywords = $1 if $make_source =~ /^$varname[ ]*=\[?([^\n\]]+)/m;
1122
1123     return $keywords;
1124 }
1125
1126 sub FindMakevarsDomain
1127 {
1128
1129     my $domain = "";
1130     my $makevars_source; {
1131         local (*IN);
1132         open (IN, "<Makevars") || return $domain;
1133         seek (IN, 0, 0);
1134         local $/; # slurp mode
1135         $makevars_source = <IN>;
1136         close IN;
1137     }
1138
1139     $domain = $1 if $makevars_source =~ /^DOMAIN[ ]*=\[?([^\n\]\$]+)/m;
1140     $domain =~ s/^\s+//;
1141     $domain =~ s/\s+$//;
1142
1143     return $domain;
1144 }
1145
1146 sub FindMakevarsBugAddress
1147 {
1148
1149     my $address = "";
1150     my $makevars_source; {
1151         local (*IN);
1152         open (IN, "<Makevars") || return undef;
1153         seek (IN, 0, 0);
1154         local $/; # slurp mode
1155         $makevars_source = <IN>;
1156         close IN;
1157     }
1158
1159     $address = $1 if $makevars_source =~ /^MSGID_BUGS_ADDRESS[ ]*=\[?([^\n\]\$]+)/m;
1160     $address =~ s/^\s+//;
1161     $address =~ s/\s+$//;
1162
1163     return $address;
1164 }