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