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 = "@VERSION@";
  34 my $PACKAGE = "@PACKAGE@";
  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 "oaf(?:\\.in)+|".       # DEPRECATED: Replaces by Bonobo .server files
  68 "etspec|".              # ?
  69 "server(?:\\.in)+|".    # Bonobo specific
  70 "sheet(?:\\.in)+|".     # ?
  71 "schemas(?:\\.in)+|".   # GConf specific
  72 "gschema.xml|".         # GLib schema (ie: GSettings) 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 $tlk_support =
  88 "tlk(?:\\.in)+";        # Bioware Aurora Talk Table Format
  89
  90 my $buildin_gettext_support =
  91 "c|y|cs|cc|cpp|c\\+\\+|h|hh|gob|py|scm(?:\\.in)*";
  92
  93 ## Always flush buffer when printing
  94 $| = 1;
  95
  96 ## Sometimes the source tree will be rooted somewhere else.
  97 my $SRCDIR = $ENV{"srcdir"} || ".";
  98 my $POTFILES_in;
  99
 100 $POTFILES_in = "<$SRCDIR/POTFILES.in";
 101
 102 my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null');
 103
 104 ## Handle options
 105 GetOptions
 106 (
 107  "help"                => \$HELP_ARG,
 108  "version"             => \$VERSION_ARG,
 109  "dist|d"              => \$DIST_ARG,
 110  "pot|p"               => \$POT_ARG,
 111  "headers|s"           => \$HEADERS_ARG,
 112  "maintain|m"          => \$MAINTAIN_ARG,
 113  "report|r"            => \$REPORT_ARG,
 114  "verbose|x"           => \$VERBOSE,
 115  "gettext-package|g=s" => \$GETTEXT_PACKAGE,
 116  "output-file|o=s"     => \$OUTPUT_FILE,
 117  ) or &Console_WriteError_InvalidOption;
 118
 119 &Console_Write_IntltoolHelp if $HELP_ARG;
 120 &Console_Write_IntltoolVersion if $VERSION_ARG;
 121
 122 my $arg_count = ($DIST_ARG > 0)
 123     + ($POT_ARG > 0)
 124     + ($HEADERS_ARG > 0)
 125     + ($MAINTAIN_ARG > 0)
 126     + ($REPORT_ARG > 0);
 127
 128 &Console_Write_IntltoolHelp if $arg_count > 1;
 129
 130 my $MODULE = $GETTEXT_PACKAGE || FindPackageName() || "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://bugs.launchpad.net/intltool
 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 $tlk_regex     = "(?:" . $tlk_support . ")";
 238    my $buildin_regex = "(?:" . $buildin_gettext_support . ")";
 239
 240    if ($type =~ /\[type: gettext\/([^\]].*)]/)
 241    {
 242         $gettext_type=$1;
 243    }
 244    elsif ($type =~ /gschema.xml$/)
 245    {
 246         $gettext_type="gsettings";
 247    }
 248    elsif ($type =~ /schemas(\.in)+$/)
 249    {
 250         $gettext_type="schemas";
 251    }
 252    elsif ($type =~ /glade2?(\.in)*$/)
 253    {
 254        $gettext_type="glade";
 255    }
 256    elsif ($type =~ /scm(\.in)*$/)
 257    {
 258        $gettext_type="scheme";
 259    }
 260    elsif ($type =~ /keys(\.in)+$/)
 261    {
 262        $gettext_type="keys";
 263    }
 264
 265    # bucket types
 266
 267    elsif ($type =~ /$xml_regex$/)
 268    {
 269        $gettext_type="xml";
 270    }
 271    elsif ($type =~ /$ini_regex$/)
 272    {
 273        $gettext_type="ini";
 274    }
 275    elsif ($type =~ /$tlk_regex$/)
 276    {
 277        $gettext_type="tlk";
 278    }
 279    elsif ($type =~ /$buildin_regex$/)
 280    {
 281        $gettext_type="buildin";
 282    }
 283    else
 284    {
 285        $gettext_type="unknown";
 286    }
 287
 288    return "gettext\/$gettext_type";
 289 }
 290
 291 sub TextFile_DetermineEncoding ($)
 292 {
 293     my $gettext_code="UTF-8"; # All files are UTF-8 by default
 294     my $filetype=`file $_ | cut -d ' ' -f 2`;
 295
 296     if ($? eq "0")
 297     {
 298         if ($filetype =~ /^(ISO|UTF)/)
 299         {
 300             chomp ($gettext_code = $filetype);
 301         }
 302         elsif ($filetype =~ /^XML/)
 303         {
 304             $gettext_code="UTF-8"; # We asume that .glade and other .xml files are UTF-8
 305         }
 306     }
 307
 308     return $gettext_code;
 309 }
 310
 311 sub isNotValidMissing
 312 {
 313     my ($file) = @_;
 314     my $package_name = "";
 315     my $version = "";
 316     $package_name = $varhash{"PACKAGE"} if (defined $varhash{"PACKAGE"});
 317     $version = $varhash{"VERSION"} if (defined $varhash{"VERSION"});
 318
 319     return if $file =~ /^\{arch\}\/.*$/;
 320     return if $file =~ /^$package_name-$version\/.*$/;
 321 }
 322
 323 sub removeFromArray
 324 {
 325     my ($file, @array) = @_;
 326
 327     my $i = 0;
 328     foreach my $potfile (@array) {
 329         delete $array[$i] if $potfile =~ m/$file/;
 330         $i++;
 331     }
 332 }
 333
 334 sub AddFileToListIfMissing
 335 {
 336     my ($file, $list) = @_;
 337
 338     my $name_pattern;
 339     if ($file =~ /^\.\.\//) {
 340         $name_pattern = "x3 A*";
 341     } else {
 342         $name_pattern = "A*";
 343     }
 344
 345     my $file_name = unpack($name_pattern, $file);
 346     if (defined isNotValidMissing ($file_name)) {
 347         ## Remove the first 3 chars if needed and add newline
 348         push @$list, $file_name . "\n";
 349     }
 350 }
 351
 352 sub FindLeftoutFiles
 353 {
 354     my (@buf_i18n_plain,
 355         @buf_i18n_xml,
 356         @buf_i18n_xml_unmarked,
 357         @buf_i18n_ini,
 358         @buf_potfiles,
 359         @buf_potfiles_ignore,
 360         @buf_allfiles,
 361         @buf_allfiles_sorted,
 362         @buf_potfiles_sorted,
 363         @buf_potfiles_ignore_sorted
 364     );
 365
 366     ## Search and find all translatable files
 367     find sub {
 368         # Ignore hidden files
 369         return if "$File::Find::name" =~ /\/\./;
 370         push @buf_i18n_plain,        "$File::Find::name" if /\.($buildin_gettext_support)$/;
 371         push @buf_i18n_xml,          "$File::Find::name" if /\.($xml_support)$/;
 372         push @buf_i18n_ini,          "$File::Find::name" if /\.($ini_support)$/;
 373         push @buf_i18n_xml_unmarked, "$File::Find::name" if /\.(schemas(\.in)+)$/;
 374         }, "..";
 375     find sub {
 376         # Ignore hidden files
 377         return if "$File::Find::name" =~ /\/\.[^.]/;
 378         push @buf_i18n_plain,        "$File::Find::name" if /\.($buildin_gettext_support)$/;
 379         push @buf_i18n_xml,          "$File::Find::name" if /\.($xml_support)$/;
 380         push @buf_i18n_ini,          "$File::Find::name" if /\.($ini_support)$/;
 381         push @buf_i18n_xml_unmarked, "$File::Find::name" if /\.(schemas(\.in)+)$/;
 382         }, "$SRCDIR/.." if "$SRCDIR" ne ".";
 383
 384     open POTFILES, $POTFILES_in or die "$PROGRAM:  there's no POTFILES.in!\n";
 385     @buf_potfiles = grep !/^(#|\s*$)/, <POTFILES>;
 386     close POTFILES;
 387
 388     foreach (@buf_potfiles) {
 389         s/^\[.*]\s*//;
 390     }
 391
 392     print "Searching for missing translatable files...\n" if $VERBOSE;
 393
 394     ## Check if we should ignore some found files, when
 395     ## comparing with POTFILES.in
 396     foreach my $ignore ("POTFILES.skip", "POTFILES.ignore")
 397     {
 398         (-s "$SRCDIR/$ignore") or next;
 399
 400         if ("$ignore" eq "POTFILES.ignore")
 401         {
 402             print "The usage of POTFILES.ignore is deprecated. Please consider moving the\n".
 403                   "content of this file to POTFILES.skip.\n";
 404         }
 405
 406         print "Found $ignore: Ignoring files...\n" if $VERBOSE;
 407         open FILE, "<$SRCDIR/$ignore" or die "ERROR: Failed to open $SRCDIR/$ignore!\n";
 408
 409         while (<FILE>)
 410         {
 411             next if (/^$/);
 412             next if (/^(#|\s*$)/);
 413
 414             my $skipdir = "../$_";
 415             $skipdir = "$SRCDIR/../$_" if "$SRCDIR" ne ".";
 416             $skipdir =~ s/\n//g;
 417
 418             my @dirignored;
 419
 420             if (-d "$skipdir")
 421             {
 422                 find sub {
 423                     push @dirignored, "$File::Find::name" if /\.($buildin_gettext_support)$/;
 424                     push @dirignored, "$File::Find::name" if /\.($xml_support)$/;
 425                     push @dirignored, "$File::Find::name" if /\.($ini_support)$/;
 426                     push @dirignored, "$File::Find::name" if /\.(schemas(\.in)+)$/;
 427                 }, "$skipdir";
 428                 foreach my $ignored (@dirignored)
 429                 {
 430                     $ignored =~ s/^$SRCDIR\///g;
 431                     $ignored =~ s/^..\///g;
 432                     $ignored =~ s/$/\n/g;
 433
 434                     removeFromArray ($ignored, @buf_i18n_plain);
 435                     removeFromArray ($ignored, @buf_i18n_xml);
 436                     removeFromArray ($ignored, @buf_i18n_ini);
 437                     removeFromArray ($ignored, @buf_i18n_xml_unmarked);
 438                     push @buf_potfiles_ignore, $ignored;
 439                 }
 440                 next;
 441             }
 442             removeFromArray ($_, @buf_i18n_plain);
 443             removeFromArray ($_, @buf_i18n_xml);
 444             removeFromArray ($_, @buf_i18n_ini);
 445             removeFromArray ($_, @buf_i18n_xml_unmarked);
 446             push @buf_potfiles_ignore, $_;
 447         }
 448         close FILE;
 449
 450         @buf_potfiles_ignore_sorted = sort (@buf_potfiles_ignore);
 451     }
 452
 453     foreach my $file (@buf_i18n_plain)
 454     {
 455         my $in_comment = 0;
 456         my $in_macro = 0;
 457         my $in_string = 0;
 458         my @multiline_quotes;
 459         if ($file =~ /\.scm/) {
 460             @multiline_quotes = ('"');
 461         } else {
 462             @multiline_quotes = ("'''", '"""');
 463         }
 464
 465         open FILE, "<$file";
 466         while (<FILE>)
 467         {
 468             if ($file =~ /\.scm/) {
 469                 # Strip single quotes from .scm files.
 470                 s-\'--g;
 471             }
 472
 473             # Handle continued multi-line comment.
 474             if ($in_comment)
 475             {
 476                 next unless s-.*\*/--;
 477                 $in_comment = 0;
 478             }
 479
 480             # Handle continued multi-line string.
 481             if ($in_string)
 482             {
 483                 my $pattern = join '|', @multiline_quotes;
 484                 if (!s/.*$pattern//) {
 485                     s///s;
 486                     next;
 487                 };
 488                 $in_string = 0;
 489             }
 490
 491             # Handle continued macro.
 492             if ($in_macro)
 493             {
 494                 $in_macro = 0 unless /\\$/;
 495                 next;
 496             }
 497
 498             # Handle start of macro (or any preprocessor directive).
 499             if (/^\s*\#/)
 500             {
 501                 $in_macro = 1 if /^([^\\]|\\.)*\\$/;
 502                 next;
 503             }
 504
 505             # Handle comments and quoted text.
 506             while (m-(/\*|//|\'\'\'|\"\"\"|\'|\")-) # \' and \" keep emacs perl mode happy
 507             {
 508                 my $match = $1;
 509                 if ($match eq "/*")
 510                 {
 511                     if (!s-/\*.*?\*/--)
 512                     {
 513                         s-/\*.*--;
 514                         $in_comment = 1;
 515                     }
 516                 }
 517                 elsif ($match eq "//")
 518                 {
 519                     s-//.*--;
 520                 }
 521                 elsif (grep($match, @multiline_quotes))
 522                 {
 523                     if (!s-$match(\\$match|[^$match])*$match-QUOTEDTEXT-g)
 524                     {
 525                         s-$match.*-QUOTEDTEXT-s;
 526                         $in_string = 1;
 527                     }
 528                 }
 529                 else # ' or "
 530                 {
 531                     s-$match(\\$match|[^$match])*$match-QUOTEDTEXT-g;
 532
 533                     # Handle inline # comments.
 534                     s/^([^$match]+)\#.*/$1/;
 535
 536                     if (m-$match-)
 537                     {
 538                         warn "mismatched quotes at line $. in $file\n";
 539                         s-$match.*--;
 540                     }
 541                 }
 542             }
 543
 544             if (/\w\.GetString *\(QUOTEDTEXT/)
 545             {
 546                 AddFileToListIfMissing($file, \@buf_allfiles);
 547                 last;
 548             }
 549
 550             ## C_ N_ NC_ Q_ and _ are the macros defined in gi8n.h
 551             if (/(NC_|[NCQ]_|[^_]_|(^|$)[_]) *\(?QUOTEDTEXT/m)
 552             {
 553                 AddFileToListIfMissing($file, \@buf_allfiles);
 554                 last;
 555             }
 556
 557             # Check for direct calls to the glib gettext wrappers
 558             if (/g_d[np]?gettext[2]? *\(QUOTEDTEXT/)
 559             {
 560                 AddFileToListIfMissing($file, \@buf_allfiles);
 561                 last;
 562             }
 563         }
 564         close FILE;
 565     }
 566
 567     foreach my $file (@buf_i18n_xml)
 568     {
 569         open FILE, "<$file";
 570
 571         while (<FILE>)
 572         {
 573             # FIXME: share the pattern matching code with intltool-extract
 574             if (/\s_[-A-Za-z0-9._:]+\s*=\s*\"([^"]+)\"/ || /<_[^>]+>/ || /translatable=\"yes\"/)
 575             {
 576                 AddFileToListIfMissing($file, \@buf_allfiles);
 577                 last;
 578             }
 579         }
 580         close FILE;
 581     }
 582
 583     foreach my $file (@buf_i18n_ini)
 584     {
 585         open FILE, "<$file";
 586         while (<FILE>)
 587         {
 588             if (/_(.*)=/)
 589             {
 590                 AddFileToListIfMissing($file, \@buf_allfiles);
 591                 last;
 592             }
 593         }
 594         close FILE;
 595     }
 596
 597     foreach my $file (@buf_i18n_xml_unmarked)
 598     {
 599         AddFileToListIfMissing($file, \@buf_allfiles);
 600     }
 601
 602
 603     @buf_allfiles_sorted = sort (@buf_allfiles);
 604     @buf_potfiles_sorted = sort (@buf_potfiles);
 605
 606     my %in2;
 607     foreach (@buf_potfiles_sorted)
 608     {
 609         s#^$SRCDIR/../##;
 610         s#^$SRCDIR/##;
 611         $in2{$_} = 1;
 612     }
 613
 614     foreach (@buf_potfiles_ignore_sorted)
 615     {
 616         s#^$SRCDIR/../##;
 617         s#^$SRCDIR/##;
 618         $in2{$_} = 1;
 619     }
 620
 621     my @result;
 622
 623     foreach (@buf_allfiles_sorted)
 624     {
 625         my $dummy = $_;
 626         my $srcdir = $SRCDIR;
 627
 628         $srcdir =~ s#^../##;
 629         $dummy =~ s#^$srcdir/../##;
 630         $dummy =~ s#^$srcdir/##;
 631         $dummy =~ s#_build/##;
 632         if (!exists($in2{$dummy}))
 633         {
 634             push @result, $dummy
 635         }
 636     }
 637
 638     my @buf_potfiles_notexist;
 639
 640     foreach (@buf_potfiles_sorted)
 641     {
 642         chomp (my $dummy = $_);
 643         if ("$dummy" ne "" and !(-f "$SRCDIR/../$dummy" or -f "../$dummy"))
 644         {
 645             push @buf_potfiles_notexist, $_;
 646         }
 647     }
 648
 649     ## Save file with information about the files missing
 650     ## if any, and give information about this procedure.
 651     if (@result + @buf_potfiles_notexist > 0)
 652     {
 653         if (@result)
 654         {
 655             print "\n" if $VERBOSE;
 656             unlink "missing";
 657             open OUT, ">missing";
 658             print OUT @result;
 659             close OUT;
 660             warn "The following files contain translations and are currently not in use. Please\n".
 661                  "consider adding these to the POTFILES.in file, located in the po/ directory.\n\n";
 662             print STDERR @result, "\n";
 663             warn "If some of these files are left out on purpose then please add them to\n".
 664                  "POTFILES.skip instead of POTFILES.in. A file 'missing' containing this list\n".
 665                  "of left out files has been written in the current directory.\n";
 666             warn "Please report to ". $varhash{"PACKAGE_BUGREPORT"} ."\n" if (defined $varhash{"PACKAGE_BUGREPORT"});
 667         }
 668         if (@buf_potfiles_notexist)
 669         {
 670             unlink "notexist";
 671             open OUT, ">notexist";
 672             print OUT @buf_potfiles_notexist;
 673             close OUT;
 674             warn "\n" if ($VERBOSE or @result);
 675             warn "The following files do not exist anymore:\n\n";
 676             warn @buf_potfiles_notexist, "\n";
 677             warn "Please remove them from POTFILES.in. A file 'notexist'\n".
 678                 "containing this list of absent files has been written in the current directory.\n";
 679             warn "Please report to ". $varhash{"PACKAGE_BUGREPORT"} ."\n" if (defined $varhash{"PACKAGE_BUGREPORT"});
 680         }
 681     }
 682
 683     ## If there is nothing to complain about, notify the user
 684     else {
 685         print "\nAll files containing translations are present in POTFILES.in.\n" if $VERBOSE;
 686     }
 687 }
 688
 689 sub Console_WriteError_InvalidOption
 690 {
 691     ## Handle invalid arguments
 692     print STDERR "Try `${PROGRAM} --help' for more information.\n";
 693     exit 1;
 694 }
 695
 696 sub isProgramInPath
 697 {
 698     my ($file) = @_;
 699     # If a file is executable (or exists on Windows),
 700     # or when it returns 0 exit status.
 701     return 1 if (
 702         ((-x $file) or ($^O eq 'MSWin32' and (-e $file))) or
 703         (system("$file --version >$devnull") == 0));
 704     return 0;
 705 }
 706
 707 sub isGNUGettextTool
 708 {
 709     my ($file) = @_;
 710     # Check that we are using GNU gettext tools
 711     if (isProgramInPath ($file))
 712     {
 713         my $version = `$file --version`;
 714         return 1 if ($version =~ m/.*\(GNU .*\).*/);
 715     }
 716     return 0;
 717 }
 718
 719 sub GenerateHeaders
 720 {
 721     my $EXTRACT = $ENV{"INTLTOOL_EXTRACT"} || "intltool-extract";
 722
 723     ## Generate the .h header files, so we can allow glade and
 724     ## xml translation support
 725     if (! isProgramInPath ("$EXTRACT"))
 726     {
 727         print STDERR "\n *** The intltool-extract script wasn't found!"
 728              ."\n *** Without it, intltool-update can not generate files.\n";
 729         exit;
 730     }
 731     else
 732     {
 733         open (FILE, $POTFILES_in) or die "$PROGRAM: POTFILES.in not found.\n";
 734
 735         while (<FILE>)
 736         {
 737            chomp;
 738            next if /^\[\s*encoding/;
 739
 740            ## Find xml files in POTFILES.in and generate the
 741            ## files with help from the extract script
 742
 743            my $gettext_type= &POFile_DetermineType ($1);
 744
 745            if (/\.($xml_support|$ini_support|$tlk_support)$/ || /^\[/)
 746            {
 747                s/^\[[^\[].*]\s*//;
 748
 749                my @cmd = ($EXTRACT, "--update", "--type=$gettext_type",
 750                           "--srcdir=$SRCDIR");
 751
 752                unshift (@cmd, $^X) if ($^O eq 'MSWin32' && !($EXTRACT =~ /perl/));
 753
 754                push (@cmd, "--quiet") if (! $VERBOSE);
 755                push (@cmd, "../$_");
 756
 757                system (@cmd);
 758            }
 759        }
 760        close FILE;
 761    }
 762 }
 763
 764 #
 765 # Generate .pot file from POTFILES.in
 766 #
 767 sub GeneratePOTemplate
 768 {
 769     my $XGETTEXT = $ENV{"XGETTEXT"} || "xgettext";
 770     my $XGETTEXT_ARGS = $ENV{"XGETTEXT_ARGS"} || '';
 771     chomp $XGETTEXT;
 772
 773     if (! isGNUGettextTool ("$XGETTEXT"))
 774     {
 775         print STDERR " *** GNU xgettext is not found on this system!\n".
 776                      " *** Without it, intltool-update can not extract strings.\n";
 777         exit;
 778     }
 779
 780     print "Building $MODULE.pot...\n" if $VERBOSE;
 781
 782     open INFILE, $POTFILES_in;
 783     unlink "POTFILES.in.temp";
 784     open OUTFILE, ">POTFILES.in.temp" or die("Cannot open POTFILES.in.temp for writing");
 785
 786     my $gettext_support_nonascii = 0;
 787
 788     # checks for GNU gettext >= 0.12
 789     my $dummy = `$XGETTEXT --version --from-code=UTF-8 >$devnull 2>$devnull`;
 790     if ($? == 0)
 791     {
 792         $gettext_support_nonascii = 1;
 793     }
 794     else
 795     {
 796         # require gnu gettext >= 0.12
 797         die "$PROGRAM: GNU gettext >= 0.12 is required for intltool\n";
 798     }
 799
 800     my $encoding = "UTF-8";
 801     my $forced_gettext_code;
 802     my @temp_headers;
 803     my $encoding_problem_is_reported = 0;
 804
 805     while (<INFILE>)
 806     {
 807         next if (/^#/ or /^\s*$/);
 808
 809         chomp;
 810
 811         my $gettext_code;
 812
 813         if (/^\[\s*encoding:\s*(.*)\s*\]/)
 814         {
 815             $forced_gettext_code=$1;
 816         }
 817         elsif (/\.($xml_support|$ini_support|$tlk_support)$/ || /^\[/)
 818         {
 819             s/^\[.*]\s*//;
 820             print OUTFILE "../$_.h\n";
 821             push @temp_headers, "../$_.h";
 822             $gettext_code = &TextFile_DetermineEncoding ("../$_.h") if ($gettext_support_nonascii and not defined $forced_gettext_code);
 823         }
 824         else
 825         {
 826             print OUTFILE "$SRCDIR/../$_\n";
 827             $gettext_code = &TextFile_DetermineEncoding ("$SRCDIR/../$_") if ($gettext_support_nonascii and not defined $forced_gettext_code);
 828         }
 829
 830         next if (! $gettext_support_nonascii);
 831
 832         if (defined $forced_gettext_code)
 833         {
 834             $encoding=$forced_gettext_code;
 835         }
 836         elsif (defined $gettext_code and "$encoding" ne "$gettext_code")
 837         {
 838             if ($encoding eq "ASCII")
 839             {
 840                 $encoding=$gettext_code;
 841             }
 842             elsif ($gettext_code ne "ASCII")
 843             {
 844                 # Only report once because the message is quite long
 845                 if (! $encoding_problem_is_reported)
 846                 {
 847                     print STDERR "WARNING: You should use the same file encoding for all your project files,\n".
 848                                  "         but $PROGRAM thinks that most of the source files are in\n".
 849                                  "         $encoding encoding, while \"$_\" is (likely) in\n".
 850                                  "         $gettext_code encoding. If you are sure that all translatable strings\n".
 851                                  "         are in same encoding (say UTF-8), please *prepend* the following\n".
 852                                  "         line to POTFILES.in:\n\n".
 853                                  "                 [encoding: UTF-8]\n\n".
 854                                  "         and make sure that configure.in/ac checks for $PACKAGE >= 0.27 .\n".
 855                                  "(such warning message will only be reported once.)\n";
 856                     $encoding_problem_is_reported = 1;
 857                 }
 858             }
 859         }
 860     }
 861
 862     close OUTFILE;
 863     close INFILE;
 864
 865     unlink "$MODULE.pot";
 866     my @xgettext_argument=("$XGETTEXT",
 867                            "--add-comments",
 868                            "--directory\=.",
 869                            "--default-domain\=$MODULE",
 870                            "--flag\=g_strdup_printf:1:c-format",
 871                            "--flag\=g_string_printf:2:c-format",
 872                            "--flag\=g_string_append_printf:2:c-format",
 873                            "--flag\=g_error_new:3:c-format",
 874                            "--flag\=g_set_error:4:c-format",
 875                            "--flag\=g_markup_printf_escaped:1:c-format",
 876                            "--flag\=g_log:3:c-format",
 877                            "--flag\=g_print:1:c-format",
 878                            "--flag\=g_printerr:1:c-format",
 879                            "--flag\=g_printf:1:c-format",
 880                            "--flag\=g_fprintf:2:c-format",
 881                            "--flag\=g_sprintf:2:c-format",
 882                            "--flag\=g_snprintf:3:c-format",
 883                            "--flag\=g_scanner_error:2:c-format",
 884                            "--flag\=g_scanner_warn:2:c-format",
 885                            "--output\=$MODULE\.pot",
 886                            "--files-from\=\.\/POTFILES\.in\.temp");
 887     my $XGETTEXT_KEYWORDS = &FindPOTKeywords;
 888     push @xgettext_argument, $XGETTEXT_KEYWORDS;
 889     my $MSGID_BUGS_ADDRESS = &FindMakevarsBugAddress;
 890     push @xgettext_argument, "--msgid-bugs-address\=\"$MSGID_BUGS_ADDRESS\"" if $MSGID_BUGS_ADDRESS;
 891     push @xgettext_argument, "--from-code\=$encoding" if ($gettext_support_nonascii);
 892     push @xgettext_argument, $XGETTEXT_ARGS if $XGETTEXT_ARGS;
 893     my $xgettext_command = join ' ', @xgettext_argument;
 894
 895     # intercept xgettext error message
 896     print "Running $xgettext_command\n" if $VERBOSE;
 897     my $xgettext_error_msg = `$xgettext_command 2>\&1`;
 898     my $command_failed = $?;
 899
 900     unlink "POTFILES.in.temp";
 901
 902     print "Removing generated header (.h) files..." if $VERBOSE;
 903     unlink foreach (@temp_headers);
 904     print "done.\n" if $VERBOSE;
 905
 906     if (! $command_failed)
 907     {
 908         if (! -e "$MODULE.pot")
 909         {
 910             print "None of the files in POTFILES.in contain strings marked for translation.\n" if $VERBOSE;
 911         }
 912         else
 913         {
 914             print "Wrote $MODULE.pot\n" if $VERBOSE;
 915         }
 916     }
 917     else
 918     {
 919         if ($xgettext_error_msg =~ /--from-code/)
 920         {
 921             my $errlocation = "unknown";
 922
 923             if ($xgettext_error_msg =~ /Non-ASCII string at (.*)\..*/)
 924             {
 925                 $errlocation = $1;
 926             }
 927             print STDERR "ERROR: xgettext failed to generate PO tempalte file because the following     \n".
 928                          "       file contains strings marked for translation, not encoded in UTF-8.    \n".
 929                          "       Please ensure all strings marked for translation are UTF-8 encoded.  \n\n".
 930                          "           $errlocation\n\n";
 931         }
 932         else
 933         {
 934             print STDERR "$xgettext_error_msg";
 935             if (-e "$MODULE.pot")
 936             {
 937                 # is this possible?
 938                 print STDERR "ERROR: xgettext failed but still managed to generate PO template file.\n".
 939                              "       Please consult error message above if there is any.\n";
 940             }
 941             else
 942             {
 943                 print STDERR "ERROR: xgettext failed to generate PO template file. Please consult\n".
 944                              "       error message above if there is any.\n";
 945             }
 946         }
 947         exit (1);
 948     }
 949 }
 950
 951 sub POFile_Update
 952 {
 953     -f "$MODULE.pot" or die "$PROGRAM: $MODULE.pot does not exist.\n";
 954
 955     my $MSGMERGE = $ENV{"MSGMERGE"} || "msgmerge";
 956     my ($lang, $outfile) = @_;
 957
 958     if (! isGNUGettextTool ("$MSGMERGE"))
 959     {
 960         print STDERR " *** GNU msgmerge is not found on this system!\n".
 961                      " *** Without it, intltool-update can not extract strings.\n";
 962         exit;
 963     }
 964
 965     print "Merging $SRCDIR/$lang.po with $MODULE.pot..." if $VERBOSE;
 966
 967     my $infile = "$SRCDIR/$lang.po";
 968     $outfile = "$SRCDIR/$lang.po" if ($outfile eq "");
 969
 970     # I think msgmerge won't overwrite old file if merge is not successful
 971     system ("$MSGMERGE", "-o", $outfile, $infile, "$MODULE.pot");
 972 }
 973
 974 sub Console_WriteError_NotExisting
 975 {
 976     my ($file) = @_;
 977
 978     ## Report error if supplied language file is non-existing
 979     print STDERR "$PROGRAM: $file does not exist!\n";
 980     print STDERR "Try '$PROGRAM --help' for more information.\n";
 981     exit;
 982 }
 983
 984 sub GatherPOFiles
 985 {
 986     my @po_files = glob ("./*.po");
 987
 988     @languages = map (&POFile_GetLanguage, @po_files);
 989
 990     foreach my $lang (@languages)
 991     {
 992         $po_files_by_lang{$lang} = shift (@po_files);
 993     }
 994 }
 995
 996 sub POFile_GetLanguage ($)
 997 {
 998     s/^(.*\/)?(.+)\.po$/$2/;
 999     return $_;
1000 }
1001
1002 sub Console_Write_TranslationStatus
1003 {
1004     my ($lang, $output_file) = @_;
1005     my $MSGFMT = $ENV{"MSGFMT"} || "msgfmt";
1006
1007     if (! isGNUGettextTool ("$MSGFMT"))
1008     {
1009         print STDERR " *** GNU msgfmt is not found on this system!\n".
1010                      " *** Without it, intltool-update can not extract strings.\n";
1011         exit;
1012     }
1013
1014     $output_file = "$SRCDIR/$lang.po" if ($output_file eq "");
1015
1016     system ("$MSGFMT", "-o", "$devnull", "--verbose", $output_file);
1017 }
1018
1019 sub Console_Write_CoverageReport
1020 {
1021     my $MSGFMT = $ENV{"MSGFMT"} || "msgfmt";
1022
1023     if (! isGNUGettextTool ("$MSGFMT"))
1024     {
1025         print STDERR " *** GNU msgfmt is not found on this system!\n".
1026                      " *** Without it, intltool-update can not extract strings.\n";
1027         exit;
1028     }
1029
1030     &GatherPOFiles;
1031
1032     foreach my $lang (@languages)
1033     {
1034         print STDERR "$lang: ";
1035         &POFile_Update ($lang, "");
1036     }
1037
1038     print STDERR "\n\n * Current translation support in $MODULE \n\n";
1039
1040     foreach my $lang (@languages)
1041     {
1042         print STDERR "$lang: ";
1043         system ("$MSGFMT", "-o", "$devnull", "--verbose", "$SRCDIR/$lang.po");
1044     }
1045 }
1046
1047 sub SubstituteVariable
1048 {
1049     my ($str) = @_;
1050
1051     # always need to rewind file whenever it has been accessed
1052     seek (CONF, 0, 0);
1053
1054     # cache each variable. varhash is global to we can add
1055     # variables elsewhere.
1056     while (<CONF>)
1057     {
1058         if (/^(\w+)=(.*)$/)
1059         {
1060             ($varhash{$1} = $2) =~  s/^["'](.*)["']$/$1/;
1061         }
1062     }
1063
1064     if ($str =~ /^(.*)\${?([A-Z_]+)}?(.*)$/)
1065     {
1066         my $rest = $3;
1067         my $untouched = $1;
1068         my $sub = "";
1069         # Ignore recursive definitions of variables
1070         $sub = $varhash{$2} if defined $varhash{$2} and $varhash{$2} !~ /\${?$2}?/;
1071
1072         return SubstituteVariable ("$untouched$sub$rest");
1073     }
1074
1075     # We're using Perl backticks ` and "echo -n" here in order to
1076     # expand any shell escapes (such as backticks themselves) in every variable
1077     return echo_n ($str);
1078 }
1079
1080 sub CONF_Handle_Open
1081 {
1082     my $base_dirname = getcwd();
1083     $base_dirname =~ s@.*/@@;
1084
1085     my ($conf_in, $src_dir);
1086
1087     if ($base_dirname =~ /^po(-.+)?$/)
1088     {
1089         if (-f "Makevars")
1090         {
1091             my $makefile_source;
1092
1093             local (*IN);
1094             open (IN, "<Makevars") || die "can't open Makevars: $!";
1095
1096             while (<IN>)
1097             {
1098                 if (/^top_builddir[ \t]*=/)
1099                 {
1100                     $src_dir = $_;
1101                     $src_dir =~ s/^top_builddir[ \t]*=[ \t]*([^ \t\n\r]*)/$1/;
1102
1103                     chomp $src_dir;
1104                     if (-f "$src_dir" . "/configure.ac") {
1105                         $conf_in = "$src_dir" . "/configure.ac" . "\n";
1106                     } else {
1107                         $conf_in = "$src_dir" . "/configure.in" . "\n";
1108                     }
1109                     last;
1110                 }
1111             }
1112             close IN;
1113
1114             $conf_in || die "Cannot find top_builddir in Makevars.";
1115         }
1116         elsif (-f "$SRCDIR/../configure.ac")
1117         {
1118             $conf_in = "$SRCDIR/../configure.ac";
1119         }
1120         elsif (-f "$SRCDIR/../configure.in")
1121         {
1122             $conf_in = "$SRCDIR/../configure.in";
1123         }
1124         else
1125         {
1126             my $makefile_source;
1127
1128             local (*IN);
1129             open (IN, "<Makefile") || return;
1130
1131             while (<IN>)
1132             {
1133                 if (/^top_srcdir[ \t]*=/)
1134                 {
1135                     $src_dir = $_;
1136                     $src_dir =~ s/^top_srcdir[ \t]*=[ \t]*([^ \t\n\r]*)/$1/;
1137
1138                     chomp $src_dir;
1139                     $conf_in = "$src_dir" . "/configure.in" . "\n";
1140
1141                     last;
1142                 }
1143             }
1144             close IN;
1145
1146             $conf_in || die "Cannot find top_srcdir in Makefile.";
1147         }
1148
1149         open (CONF, "<$conf_in");
1150     }
1151     else
1152     {
1153         print STDERR "$PROGRAM: Unable to proceed.\n" .
1154                      "Make sure to run this script inside the po directory.\n";
1155         exit;
1156     }
1157 }
1158
1159 sub FindPackageName
1160 {
1161     my $version;
1162     my $domain = &FindMakevarsDomain;
1163     my $name = $domain || "untitled";
1164     my $bugurl;
1165
1166     &CONF_Handle_Open;
1167
1168     my $conf_source; {
1169         local (*IN);
1170         open (IN, "<&CONF") || return $name;
1171         seek (IN, 0, 0);
1172         local $/; # slurp mode
1173         $conf_source = <IN>;
1174         close IN;
1175     }
1176
1177     # priority for getting package name:
1178     # 1. GETTEXT_PACKAGE
1179     # 2. first argument of AC_INIT (with >= 2 arguments)
1180     # 3. first argument of AM_INIT_AUTOMAKE (with >= 2 argument)
1181
1182     # /^AM_INIT_AUTOMAKE\([\s\[]*([^,\)\s\]]+)/m
1183     # the \s makes this not work, why?
1184     if ($conf_source =~ /^AM_INIT_AUTOMAKE\(([^,\)]+),([^,\)]+)/m)
1185     {
1186         ($name, $version) = ($1, $2);
1187         $name    =~ s/[\[\]\s]//g;
1188         $version =~ s/[\[\]\s]//g;
1189         $name    =~ s/\(+$//g;
1190         $version =~ s/\(+$//g;
1191
1192         $varhash{"PACKAGE_NAME"} = $name if (not $name =~ /\${?AC_PACKAGE_NAME}?/);
1193         $varhash{"PACKAGE"} = $name if (not $name =~ /\${?PACKAGE}?/);
1194         $varhash{"PACKAGE_VERSION"} = $version if (not $name =~ /\${?AC_PACKAGE_VERSION}?/);
1195         $varhash{"VERSION"} = $version if (not $name =~ /\${?VERSION}?/);
1196     }
1197
1198     if ($conf_source =~ /^AC_INIT\(([^,\)]+),([^,\)]+)[,]?([^,\)]+)?/m)
1199     {
1200         ($name, $version) = ($1, $2);
1201         $bugurl = $3 if (defined $3);
1202
1203         # Handle m4_esyscmd
1204         # FIXME: We should do this in a more generic way that works for all vars
1205         if ($version =~ /m4_esyscmd\([\[]?([^\)\]]+)/)
1206         {
1207             my $cwd = getcwd ();
1208             chdir ("$SRCDIR/..");
1209             $version = qx($1);
1210             chdir ($cwd);
1211         }
1212
1213
1214         $name    =~ s/[\[\]\s]//g;
1215         $version =~ s/[\[\]\s]//g;
1216         $bugurl  =~ s/[\[\]\s]//g if (defined $bugurl);
1217         $name    =~ s/\(+$//g;
1218         $version =~ s/\(+$//g;
1219         $bugurl  =~ s/\(+$//g if (defined $bugurl);
1220
1221         $varhash{"PACKAGE_NAME"} = $name if (not $name =~ /\${?AC_PACKAGE_NAME}?/);
1222         $varhash{"PACKAGE"} = $name if (not $name =~ /\${?PACKAGE}?/);
1223         $varhash{"PACKAGE_VERSION"} = $version if (not $name =~ /\${?AC_PACKAGE_VERSION}?/);
1224         $varhash{"VERSION"} = $version if (not $name =~ /\${?VERSION}?/);
1225         $varhash{"PACKAGE_BUGREPORT"} = $bugurl if (defined $bugurl and not $bugurl =~ /\${?\w+}?/);
1226     }
1227
1228     # \s makes this not work, why?
1229     $name = $1 if $conf_source =~ /^GETTEXT_PACKAGE=\[?([^\n\]]+)/m;
1230
1231     # m4 macros AC_PACKAGE_NAME, AC_PACKAGE_VERSION etc. have same value
1232     # as corresponding $PACKAGE_NAME, $PACKAGE_VERSION etc. shell variables.
1233     $name =~ s/\bAC_PACKAGE_/\$PACKAGE_/g;
1234
1235     $name = $domain if $domain;
1236
1237     $name = SubstituteVariable ($name);
1238     $name =~ s/^["'](.*)["']$/$1/;
1239
1240     return $name if $name;
1241 }
1242
1243
1244 sub FindPOTKeywords
1245 {
1246
1247     my $keywords = "--keyword=_ --keyword=N_ --keyword=C_:1c,2 --keyword=NC_:1c,2 --keyword=Q_ --keyword=g_dgettext:2 --keyword=g_dngettext:2,3 --keyword=g_dpgettext:2 --keyword=g_dpgettext2=2c,3";
1248     my $varname = "XGETTEXT_OPTIONS";
1249     my $make_source; {
1250         local (*IN);
1251         open (IN, "<Makevars") || (open(IN, "<Makefile.in.in") && ($varname = "XGETTEXT_KEYWORDS")) || return $keywords;
1252         seek (IN, 0, 0);
1253         local $/; # slurp mode
1254         $make_source = <IN>;
1255         close IN;
1256     }
1257
1258     # unwrap lines split with a trailing \
1259     $make_source =~  s/\\ $ \n/ /mxg;
1260     $keywords = $1 if $make_source =~ /^$varname[ ]*=\[?([^\n\]]+)/m;
1261
1262     return $keywords;
1263 }
1264
1265 sub FindMakevarsDomain
1266 {
1267
1268     my $domain = "";
1269     my $makevars_source; {
1270         local (*IN);
1271         open (IN, "<Makevars") || return $domain;
1272         seek (IN, 0, 0);
1273         local $/; # slurp mode
1274         $makevars_source = <IN>;
1275         close IN;
1276     }
1277
1278     $domain = $1 if $makevars_source =~ /^DOMAIN[ ]*=\[?([^\n\]\$]+)/m;
1279     $domain =~ s/^\s+//;
1280     $domain =~ s/\s+$//;
1281
1282     return $domain;
1283 }
1284
1285 sub FindMakevarsBugAddress
1286 {
1287
1288     my $address = "";
1289     my $makevars_source; {
1290         local (*IN);
1291         open (IN, "<Makevars") || return undef;
1292         seek (IN, 0, 0);
1293         local $/; # slurp mode
1294         $makevars_source = <IN>;
1295         close IN;
1296     }
1297
1298     $address = $1 if $makevars_source =~ /^MSGID_BUGS_ADDRESS[ ]*=\[?([^\n\]\$]+)/m;
1299     $address =~ s/^\s+//;
1300     $address =~ s/\s+$//;
1301
1302     return $address;
1303 }