git.hungrycats.org Git - xscreensaver/blob - intltool-update.in

   1 #!@INTLTOOL_PERL@ -w
   2
   3 #
   4 #  The Intltool Message Updater
   5 #
   6 #  Copyright (C) 2000-2002 Free Software Foundation.
   7 #
   8 #  Intltool is free software; you can redistribute it and/or
   9 #  modify it under the terms of the GNU General Public License
  10 #  version 2 published by the Free Software Foundation.
  11 #
  12 #  Intltool is distributed in the hope that it will be useful,
  13 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 #  General Public License for more details.
  16 #
  17 #  You should have received a copy of the GNU General Public License
  18 #  along with this program; if not, write to the Free Software
  19 #  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20 #
  21 #  As a special exception to the GNU General Public License, if you
  22 #  distribute this file as part of a program that contains a
  23 #  configuration script generated by Autoconf, you may include it under
  24 #  the same distribution terms that you use for the rest of that program.
  25 #
  26 #  Authors: Kenneth Christiansen <kenneth@gnu.org>
  27 #           Maciej Stachowiak
  28 #           Darin Adler <darin@bentspoon.com>
  29
  30 ## Release information
  31 my $PROGRAM = "intltool-update";
  32 my $VERSION = "0.18";
  33 my $PACKAGE = "intltool";
  34
  35 ## Loaded modules
  36 use strict;
  37 use Getopt::Long;
  38 use Cwd;
  39 use File::Copy;
  40 use File::Find;
  41
  42 ## Scalars used by the option stuff
  43 my $HELP_ARG       = 0;
  44 my $VERSION_ARG    = 0;
  45 my $DIST_ARG       = 0;
  46 my $POT_ARG        = 0;
  47 my $HEADERS_ARG    = 0;
  48 my $MAINTAIN_ARG   = 0;
  49 my $REPORT_ARG     = 0;
  50 my $VERBOSE        = 0;
  51 my $GETTEXT_PACKAGE = "";
  52
  53 my @languages;
  54 my %po_files_by_lang = ();
  55
  56 # Regular expressions to categorize file types.
  57 # FIXME: Please check if the following is correct
  58
  59 my $xml_extension =
  60 "xml(\.in)*|".          # .in is not required
  61 "ui|".
  62 "glade2?(\.in)*|".      # .in is not required
  63 "scm(\.in)*|".          # .in is not required
  64 "oaf(\.in)+|".
  65 "etspec|".
  66 "sheet(\.in)+|".
  67 "pong(\.in)+";
  68
  69 my $ini_extension =
  70 "desktop(\.in)+|".
  71 "caves(\.in)+|".
  72 "directory(\.in)+|".
  73 "soundlist(\.in)+|".
  74 "keys(\.in)+|".
  75 "server(\.in)+";
  76
  77 ## Always print as the first thing
  78 $| = 1;
  79
  80 ## Handle options
  81 GetOptions
  82 (
  83  "help"                => \$HELP_ARG,
  84  "version"             => \$VERSION_ARG,
  85  "dist|d"              => \$DIST_ARG,
  86  "pot|p"               => \$POT_ARG,
  87  "headers|s"           => \$HEADERS_ARG,
  88  "maintain|m"          => \$MAINTAIN_ARG,
  89  "report|r"            => \$REPORT_ARG,
  90  "verbose|x"           => \$VERBOSE,
  91  "gettext-package|g=s" => \$GETTEXT_PACKAGE,
  92  ) or &print_error_invalid_option;
  93
  94 &print_help if $HELP_ARG;
  95 &print_version if $VERSION_ARG;
  96
  97 my $arg_count = ($DIST_ARG > 0)
  98     + ($POT_ARG > 0)
  99     + ($HEADERS_ARG > 0)
 100     + ($MAINTAIN_ARG > 0)
 101     + ($REPORT_ARG > 0);
 102 &print_help if $arg_count > 1;
 103
 104 # --version and --help don't require a module name
 105 my $MODULE = $GETTEXT_PACKAGE || &find_package_name;
 106
 107 if ($DIST_ARG) {
 108     if ($ARGV[0] =~ /^[a-z]/){
 109         &update_po_file ($ARGV[0]);
 110         &print_status ($ARGV[0]);
 111     } else {
 112         &print_help;
 113     }
 114 } elsif ($POT_ARG) {
 115     &generate_headers;
 116     &generate_po_template;
 117 } elsif ($HEADERS_ARG) {
 118     &generate_headers;
 119 } elsif ($MAINTAIN_ARG) {
 120     &find_leftout_files;
 121 } elsif ($REPORT_ARG) {
 122     &print_report;
 123 } else {
 124     if ($ARGV[0] =~ /^[a-z]/) {
 125         &main ($ARGV[0]);
 126     } else {
 127         &print_help;
 128     }
 129 }
 130
 131 exit;
 132
 133 #########
 134
 135 sub print_version
 136 {
 137     ## Print version information
 138     print "${PROGRAM} (${PACKAGE}) $VERSION\n";
 139     print "Written by Kenneth Christiansen, Maciej Stachowiak, and Darin Adler.\n\n";
 140     print "Copyright (C) 2000-2002 Free Software Foundation, Inc.\n";
 141     print "This is free software; see the source for copying conditions.  There is NO\n";
 142     print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
 143     exit;
 144 }
 145
 146 sub print_help
 147 {
 148     ## Print usage information
 149     print "Usage: ${PROGRAM} [OPTIONS] ...LANGCODE\n";
 150     print "Updates PO template files and merge them with the translations.\n\n";
 151     print "  -p, --pot              generate the PO template only\n";
 152     print "  -s, --headers          generate the header files in POTFILES.in\n";
 153     print "  -m, --maintain         search for left out files from POTFILES.in\n";
 154     print "  -r, --report           display a status report for the module.\n";
 155     print "  -x, --verbose          display lots of feedback\n";
 156     print "      --help             display this help and exit\n";
 157     print "      --version          output version information and exit\n";
 158     print "\nExamples of use:\n";
 159     print "${PROGRAM} --pot    just creates a new PO template from the source\n";
 160     print "${PROGRAM} da       created new PO template and updated the da.po file\n\n";
 161     print "Report bugs to bugzilla.gnome.org, module 'intltool'.\n";
 162     exit;
 163 }
 164
 165 sub main
 166 {
 167     my ($lang) = @_;
 168
 169     ## Report error if the language file supplied
 170     ## to the command line is non-existent
 171     &print_error_not_existing("$lang.po") if ! -s "$lang.po";
 172
 173     print "Working, please wait..." unless $VERBOSE;
 174     &generate_headers;
 175     &generate_po_template;
 176     &update_po_file ($lang);
 177     &print_status ($lang);
 178 }
 179
 180 sub determine_type ($)
 181 {
 182    my $type = $_;
 183    my $gettext_type;
 184
 185    # FIXME: Use $xml_extentions, and maybe do all this even nicer
 186    my $xml_regex =
 187        "(?:xml(\.in)*|ui|oaf(?:\.in)+|server(?:\.in)+|sheet(?:\.in)+|".
 188        "pong(?:\.in)+|etspec)";
 189    my $ini_regex =
 190        "(?:desktop(?:\.in)+|caves(?:\.in)+|directory(?:\.in)+|".
 191        "soundlist(?:\.in)+)";
 192
 193    if ($type =~ /\[type: gettext\/([^\]].*)]/) {
 194         $gettext_type=$1;
 195    }
 196    elsif ($type =~ /$xml_regex$/) {
 197         $gettext_type="xml";
 198    }
 199    elsif ($type =~ /glade2?(\.in)*$/) {
 200         $gettext_type="glade";
 201    }
 202    elsif ($type =~ /$ini_regex$/) {
 203         $gettext_type="ini";
 204    }
 205    elsif ($type =~ /scm(\.in)*$/) {
 206         $gettext_type="scheme";
 207    }
 208    elsif ($type =~ /keys(\.in)+$/) {
 209         $gettext_type="keys";
 210    }
 211    else { $gettext_type=""; }
 212
 213    return "gettext\/$gettext_type";
 214 }
 215
 216 sub find_leftout_files
 217 {
 218     my (@buf_i18n_plain,
 219         @buf_i18n_xml,
 220         @buf_i18n_ini,
 221         @buf_potfiles,
 222         @buf_potfiles_ignore,
 223         @buf_allfiles,
 224         @buf_allfiles_sorted,
 225         @buf_potfiles_sorted
 226     );
 227
 228     ## Search and find all translatable files
 229     find sub {
 230         push @buf_i18n_plain, "$File::Find::name" if /\.(c|y|cc|cpp|c\+\+|h|gob)$/
 231         }, "..";
 232     find sub {
 233         push @buf_i18n_xml, "$File::Find::name" if /\.($xml_extension)$/
 234         }, "..";
 235     find sub {
 236         push @buf_i18n_ini, "$File::Find::name" if /\.($ini_extension)$/
 237         }, "..";
 238
 239     open POTFILES, "POTFILES.in" || die "$PROGRAM:  there's no POTFILES.in!\n";
 240
 241     @buf_potfiles = grep /^[^#]/, <POTFILES>;
 242
 243     print "Searching for missing translatable files...\n" if $VERBOSE;
 244
 245     ## Check if we should ignore some found files, when
 246     ## comparing with POTFILES.in
 247     foreach my $ignore ("POTFILES.skip", "POTFILES.ignore") {
 248         if (-s $ignore) {
 249             open FILE, $ignore;
 250             while (<FILE>) {
 251                 if (/^[^#]/){
 252                     push @buf_potfiles_ignore, $_;
 253                 }
 254             }
 255             print "Found $ignore: Ignoring files...\n" if $VERBOSE;
 256             @buf_potfiles = (@buf_potfiles_ignore, @buf_potfiles);
 257         }
 258     }
 259
 260     foreach my $file (@buf_i18n_plain)
 261       {
 262         my $in_comment = 0;
 263         my $in_macro = 0;
 264
 265         open FILE, "<$file";
 266         while (<FILE>)
 267           {
 268             # Handle continued multi-line comment.
 269             if ($in_comment)
 270               {
 271                 next unless s-.*\*/--;
 272                 $in_comment = 0;
 273               }
 274
 275             # Handle continued macro.
 276             if ($in_macro)
 277               {
 278                 $in_macro = 0 unless /\\$/;
 279                 next;
 280               }
 281
 282             # Handle start of macro (or any preprocessor directive).
 283             if (/^\s*\#/)
 284               {
 285                 $in_macro = 1 if /^([^\\]|\\.)*\\$/;
 286                 next;
 287               }
 288
 289             # Handle comments and quoted text.
 290             while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy
 291               {
 292                 my $match = $1;
 293                 if ($match eq "/*")
 294                   {
 295                     if (!s-/\*.*?\*/--)
 296                       {
 297                         s-/\*.*--;
 298                         $in_comment = 1;
 299                       }
 300                   }
 301                 elsif ($match eq "//")
 302                   {
 303                     s-//.*--;
 304                   }
 305                 else # ' or "
 306                   {
 307                     if (!s-$match([^\\]|\\.)*?$match-QUOTEDTEXT-)
 308                       {
 309                         warn "mismatched quotes at line $. in $file\n";
 310                         s-$match.*--;
 311                       }
 312                   }
 313               }
 314
 315
 316             if (/_\(QUOTEDTEXT/)
 317               {
 318                 ## Remove the first 3 chars and add newline
 319                 push @buf_allfiles, unpack("x3 A*", $file) . "\n";
 320                 last;
 321               }
 322           }
 323         close FILE;
 324       }
 325
 326     foreach my $file (@buf_i18n_xml) {
 327         open FILE, "<$file";
 328         while (<FILE>) {
 329             if (/\s_(.*)=\"/){
 330                 push @buf_allfiles, unpack("x3 A*", $file) . "\n";
 331                 last;
 332             }
 333         }
 334     }
 335
 336     foreach my $file (@buf_i18n_ini){
 337         open FILE, "<$file";
 338         while (<FILE>) {
 339             if (/_(.*)=/){
 340                 push @buf_allfiles, unpack("x3 A*", $file) . "\n";
 341                 last;
 342             }
 343         }
 344     }
 345
 346     @buf_allfiles_sorted = sort (@buf_allfiles);
 347     @buf_potfiles_sorted = sort (@buf_potfiles);
 348
 349     my %in2;
 350     foreach (@buf_potfiles_sorted) {
 351         $in2{$_} = 1;
 352     }
 353
 354     my @result;
 355
 356     foreach (@buf_allfiles_sorted){
 357         if (!exists($in2{$_})){
 358             push @result, $_
 359         }
 360     }
 361
 362     ## Save file with information about the files missing
 363     ## if any, and give information about this procedure.
 364     if (@result) {
 365         print "\n" if $VERBOSE;
 366         open OUT, ">missing";
 367         print OUT @result;
 368         print "The following files contain translations and are currently not in use. Please\n";
 369         print "consider adding these to the POTFILES.in file, located in the po/ directory.\n\n";
 370         print @result, "\n";
 371         print "If some of these files are left out on purpose then please add them to\n";
 372         print "POTFILES.skip instead of POTFILES.in. A file 'missing' containing this list\n";
 373         print "of left out files has been written in the current directory.\n";
 374     }
 375
 376     ## If there is nothing to complain about, notify the user
 377     else {
 378         print "\nAll files containing translations are present in POTFILES.in.\n";
 379     }
 380 }
 381
 382 sub print_error_invalid_option
 383 {
 384     ## Handle invalid arguments
 385     print "Try `${PROGRAM} --help' for more information.\n";
 386     exit 1;
 387 }
 388
 389 sub generate_headers
 390 {
 391     my $EXTRACT = `which intltool-extract 2>/dev/null`;
 392     chomp $EXTRACT;
 393
 394     $EXTRACT = $ENV{"INTLTOOL_EXTRACT"} if $ENV{"INTLTOOL_EXTRACT"};
 395
 396     ## Generate the .h header files, so we can allow glade and
 397     ## xml translation support
 398     if (! -s $EXTRACT)
 399     {
 400         print "\n *** The intltool-extract script wasn't found!"
 401              ."\n *** Without it, intltool-update can not generate files.\n";
 402         exit;
 403     }
 404     else
 405     {
 406         open FILE, "<POTFILES.in";
 407         while (<FILE>) {
 408            chomp;
 409
 410            ## Find xml files in POTFILES.in and generate the
 411            ## files with help from the extract script
 412
 413            my $gettext_type= &determine_type ($1);
 414
 415            if (/\.($xml_extension|$ini_extension)$/ || /^\[/){
 416                $_ =~ s/^\[[^\[].*]\s*//;
 417                my $filename = "../$_";
 418
 419                if ($VERBOSE){
 420                    system($EXTRACT, "--update", "--type=$gettext_type", $filename);
 421                } else {
 422                    system($EXTRACT, "--update", "--type=$gettext_type", "--quiet", $filename);
 423                }
 424            }
 425        }
 426        close FILE;
 427    }
 428 }
 429
 430 sub generate_po_template
 431 {
 432     ## Generate the potfiles from the POTFILES.in file
 433
 434     print "Building the $MODULE.pot...\n" if $VERBOSE;
 435
 436     move ("POTFILES.in", "POTFILES.in.old");
 437
 438     open INFILE, "<POTFILES.in.old";
 439     open OUTFILE, ">POTFILES.in";
 440     while (<INFILE>) {
 441         s/\.($xml_extension|$ini_extension)$/$&.h/;
 442         s/^\[.*]\s*(.*)/$1.h/;
 443         print OUTFILE $_;
 444     }
 445     close OUTFILE;
 446     close INFILE;
 447
 448     system ("xgettext", "--default-domain\=$MODULE",
 449                         "--directory\=\.\.",
 450                         "--add-comments",
 451                         "--keyword\=\_",
 452                         "--keyword\=N\_",
 453                         "--keyword\=U\_",
 454                         "--files-from\=\.\/POTFILES\.in");
 455
 456     if (!-e "$MODULE.po") {
 457         print "WARNING: It seems that none of the files in POTFILES.in ".
 458               "contain marked strings\n";
 459         exit (1);
 460     }
 461
 462     system ("rm", "-f", "$MODULE.pot");
 463     move ("$MODULE.po", "$MODULE.pot") || die "$PROGRAM: couldn't move $MODULE.po to $MODULE.pot.\n";
 464
 465     print "Wrote $MODULE.pot\n" if $VERBOSE;
 466
 467     move ("POTFILES.in.old", "POTFILES.in");
 468
 469     print "Removing generated header (.h) files..." if $VERBOSE;
 470
 471     open FILE, "<POTFILES.in";
 472
 473     while (<FILE>)
 474     {
 475         chomp;
 476         unlink "../$_.h" if /\.($xml_extension|$ini_extension)$/;
 477     }
 478
 479     close FILE;
 480     print "done\n" if $VERBOSE;
 481 }
 482
 483 sub update_po_file
 484 {
 485     my ($lang) = @_;
 486
 487     print "Merging $lang.po with $MODULE.pot..." if $VERBOSE;
 488
 489     copy ("$lang.po", "$lang.po.old") || die "copy failed: $!";
 490
 491     # Perform merge, remove backup file and the "messages" trash file
 492     # generated by gettext
 493     system ("msgmerge", "$lang.po.old", "$MODULE.pot", "-o", "$lang.po");
 494     unlink "$lang.po.old";
 495     unlink "messages";
 496 }
 497
 498 sub print_error_not_existing
 499 {
 500     my ($file) = @_;
 501
 502     ## Report error if supplied language file is non-existing
 503     print "$PROGRAM: $file does not exist!\n";
 504     print "Try '$PROGRAM --help' for more information.\n";
 505     exit;
 506 }
 507
 508 sub gather_po_files
 509 {
 510     my @po_files = glob ("./*.po");
 511
 512     @languages = map (&po_file2lang, @po_files);
 513
 514     foreach my $lang (@languages) {
 515         $po_files_by_lang{$lang} = shift (@po_files);
 516     }
 517 }
 518
 519 sub po_file2lang ($)
 520 {
 521     my $tmp = $_;
 522     $tmp =~ s/^.*\/(.*)\.po$/$1/;
 523     return $tmp;
 524 }
 525
 526 sub print_status
 527 {
 528     my ($lang) = @_;
 529
 530     system ("msgfmt", "--statistics", "$lang.po");
 531     print "\n";
 532 }
 533
 534 sub print_report
 535 {
 536     &generate_headers;
 537     &generate_po_template;
 538     &gather_po_files;
 539
 540     foreach my $lang (@languages) {
 541         print "$lang: ";
 542         &update_po_file ($lang);
 543     }
 544
 545     print "\n\n * Current translation support in $MODULE \n\n";
 546
 547     foreach my $lang (@languages){
 548         print "$lang: ";
 549         system ("msgfmt", "--statistics", "$lang.po");
 550     }
 551 }
 552
 553 sub find_package_name
 554 {
 555     my $base_dirname = getcwd();
 556     $base_dirname =~ s@.*/@@;
 557
 558     my ($conf_in, $src_dir);
 559
 560     if ($base_dirname =~ /^po(-.+)?$/) {
 561         if (-f "../configure.in") {
 562             $conf_in = "../configure.in";
 563         } else {
 564             my $makefile_source;
 565             local (*IN);
 566             open IN, "<Makefile" || die "can't open Makefile: $!";
 567
 568             while (<IN>) {
 569                 if (/^top_srcdir[ \t]*=/) {
 570                     $src_dir = $_;
 571                     # print "${src_dir}\n";
 572
 573                     $src_dir =~ s/^top_srcdir[ \t]*=[ \t]*([^ \t\n\r]*)/$1/;
 574                     # print "${src_dir}\n";
 575                     chomp $src_dir;
 576                     $conf_in = "$src_dir" . "/configure.in" . "\n";
 577                     last;
 578                 }
 579             }
 580             $conf_in || die "Cannot find top_srcdir in Makefile."
 581         }
 582
 583         my $conf_source; {
 584            local (*IN);
 585            local $/; # slurp mode
 586            open (IN, "<$conf_in") || die "can't open $conf_in: $!";
 587            $conf_source = <IN>;
 588         }
 589
 590         my $name = "";
 591         $name = $1 if $conf_source =~ /^AM_INIT_AUTOMAKE\(([^,\)]+)/m;
 592         $name = $1 if $conf_source =~ /^GETTEXT_PACKAGE=(\S+)/m;
 593         if ($name =~ /^[\$](\S+)/) {
 594             return $1 if $conf_source =~ /^\s*$1=(\S*)/m;
 595         }
 596         return $name if $name;
 597     }
 598
 599     print "$PROGRAM: Unable to determine package name.\n" .
 600           "Make sure to run this script inside the po directory.\n";
 601     exit;
 602 }