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

   1 #!@INTLTOOL_PERL@ -w
   2
   3 #
   4 #  The Intltool Message Merger
   5 #
   6 #  Copyright (C) 2000, 2002 Free Software Foundation.
   7 #  Copyright (C) 2000, 2001 Eazel, Inc
   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:  Maciej Stachowiak <mjs@noisehavoc.org>
  28 #            Kenneth Christiansen <kenneth@gnu.org>
  29 #            Darin Adler <darin@bentspoon.com>
  30 #
  31 #  Proper XML UTF-8'ification written by Cyrille Chepelov <chepelov@calixo.net>
  32 #
  33
  34 ## Release information
  35 my $PROGRAM = "intltool-merge";
  36 my $PACKAGE = "intltool";
  37 my $VERSION = "0.18";
  38
  39 ## Loaded modules
  40 use strict;
  41 use Getopt::Long;
  42
  43 ## Scalars used by the option stuff
  44 my $HELP_ARG = 0;
  45 my $VERSION_ARG = 0;
  46 my $BA_STYLE_ARG = 0;
  47 my $XML_STYLE_ARG = 0;
  48 my $KEYS_STYLE_ARG = 0;
  49 my $DESKTOP_STYLE_ARG = 0;
  50 my $QUIET_ARG = 0;
  51 my $PASS_THROUGH_ARG = 0;
  52 my $UTF8_ARG = 0;
  53 my $cache_file;
  54
  55 ## Handle options
  56 GetOptions
  57 (
  58  "help" => \$HELP_ARG,
  59  "version" => \$VERSION_ARG,
  60  "quiet|q" => \$QUIET_ARG,
  61  "oaf-style|o" => \$BA_STYLE_ARG, ## for compatibility
  62  "ba-style|b" => \$BA_STYLE_ARG,
  63  "xml-style|x" => \$XML_STYLE_ARG,
  64  "keys-style|k" => \$KEYS_STYLE_ARG,
  65  "desktop-style|d" => \$DESKTOP_STYLE_ARG,
  66  "pass-through|p" => \$PASS_THROUGH_ARG,
  67  "utf8|u" => \$UTF8_ARG,
  68  "cache|c=s" => \$cache_file
  69  ) or &error;
  70
  71 my $PO_DIR;
  72 my $FILE;
  73 my $OUTFILE;
  74
  75 my %po_files_by_lang = ();
  76 my %translations = ();
  77
  78 # Use this instead of \w for XML files to handle more possible characters.
  79 my $w = "[-A-Za-z0-9._:]";
  80
  81 # XML quoted string contents
  82 my $q = "[^\\\"]*";
  83
  84 ## Check for options.
  85
  86 if ($VERSION_ARG) {
  87         &print_version;
  88 } elsif ($HELP_ARG) {
  89         &print_help;
  90 } elsif ($BA_STYLE_ARG && @ARGV > 2) {
  91         &preparation;
  92         &print_message;
  93         &ba_merge_translations;
  94         &finalize;
  95 } elsif ($XML_STYLE_ARG && @ARGV > 2) {
  96         &utf8_sanity_check;
  97         &preparation;
  98         &print_message;
  99         &xml_merge_translations;
 100         &finalize;
 101 } elsif ($KEYS_STYLE_ARG && @ARGV > 2) {
 102         &utf8_sanity_check;
 103         &preparation;
 104         &print_message;
 105         &keys_merge_translations;
 106         &finalize;
 107 } elsif ($DESKTOP_STYLE_ARG && @ARGV > 2) {
 108         &preparation;
 109         &print_message;
 110         &desktop_merge_translations;
 111         &finalize;
 112 } else {
 113         &print_help;
 114 }
 115
 116 exit;
 117
 118 ## Sub for printing release information
 119 sub print_version
 120 {
 121     print "${PROGRAM} (${PACKAGE}) ${VERSION}\n";
 122     print "Written by Maciej Stachowiak, Darin Adler and Kenneth Christiansen.\n\n";
 123     print "Copyright (C) 2000-2002 Free Software Foundation, Inc.\n";
 124     print "Copyright (C) 2000-2001 Eazel, Inc.\n";
 125     print "This is free software; see the source for copying conditions.  There is NO\n";
 126     print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
 127     exit;
 128 }
 129
 130 ## Sub for printing usage information
 131 sub print_help
 132 {
 133     print "Usage: ${PROGRAM} [OPTIONS] PO_DIRECTORY FILENAME OUTPUT_FILE\n";
 134     print "Generates an output file that includes translated versions of some attributes,\n";
 135     print "from an untranslated source and a po directory that includes translations.\n\n";
 136     print "  -b, --ba-style         includes translations in the bonobo-activation style\n";
 137     print "  -d, --desktop-style    includes translations in the desktop style\n";
 138     print "  -k, --keys-style       includes translations in the keys style\n";
 139     print "  -x, --xml-style        includes translations in the standard xml style\n";
 140     print "  -u, --utf8             convert all strings to UTF-8 before merging\n";
 141     print "  -p, --pass-through     use strings as found in .po files, without\n";
 142     print "                         conversion (STRONGLY unrecommended with -x)\n";
 143     print "  -q, --quiet            suppress most messages\n";
 144     print "      --help             display this help and exit\n";
 145     print "      --version          output version information and exit\n";
 146     print "\nReport bugs to bugzilla.gnome.org, module intltool, or contact us through \n";
 147     print "<xml-i18n-tools-list\@gnome.org>.\n";
 148     exit;
 149 }
 150
 151
 152 ## Sub for printing error messages
 153 sub print_error
 154 {
 155     print "Try `${PROGRAM} --help' for more information.\n";
 156     exit;
 157 }
 158
 159
 160 sub print_message
 161 {
 162     print "Merging translations into $OUTFILE.\n" unless $QUIET_ARG;
 163 }
 164
 165
 166 sub preparation
 167 {
 168     $PO_DIR = $ARGV[0];
 169     $FILE = $ARGV[1];
 170     $OUTFILE = $ARGV[2];
 171
 172     &gather_po_files;
 173     &get_translation_database;
 174 }
 175
 176 # General-purpose code for looking up translations in .po files
 177
 178 sub po_file2lang
 179 {
 180     my ($tmp) = @_;
 181     $tmp =~ s/^.*\/(.*)\.po$/$1/;
 182     return $tmp;
 183 }
 184
 185 sub gather_po_files
 186 {
 187     for my $po_file (glob "$PO_DIR/*.po") {
 188         $po_files_by_lang{po_file2lang($po_file)} = $po_file;
 189     }
 190 }
 191
 192 sub get_po_encoding
 193 {
 194     my ($in_po_file) = @_;
 195     my $encoding = "";
 196
 197     open IN_PO_FILE, $in_po_file or die;
 198     while (<IN_PO_FILE>) {
 199         ## example: "Content-Type: text/plain; charset=ISO-8859-1\n"
 200         if (/Content-Type\:.*charset=([-a-zA-Z0-9]+)\\n/) {
 201             $encoding = $1;
 202             last;
 203         }
 204     }
 205     close IN_PO_FILE;
 206
 207     if (!$encoding) {
 208         print "Warning: no encoding found in $in_po_file. Assuming ISO-8859-1\n";
 209         $encoding = "ISO-8859-1";
 210     }
 211     return $encoding
 212 }
 213
 214 sub utf8_sanity_check
 215 {
 216     if (!$UTF8_ARG) {
 217         if (!$PASS_THROUGH_ARG) {
 218             $PASS_THROUGH_ARG="1";
 219         }
 220     }
 221 }
 222
 223 sub get_translation_database
 224 {
 225     if ($cache_file) {
 226         &get_cached_translation_database;
 227     } else {
 228         &create_translation_database;
 229     }
 230 }
 231
 232 sub get_newest_po_age
 233 {
 234     my $newest_age;
 235
 236     foreach my $file (values %po_files_by_lang) {
 237         my $file_age = -M $file;
 238         $newest_age = $file_age if !$newest_age || $file_age < $newest_age;
 239     }
 240
 241     return $newest_age;
 242 }
 243
 244 sub create_cache
 245 {
 246     print "Generating and caching the translation database\n" unless $QUIET_ARG;
 247
 248     &create_translation_database;
 249
 250     open CACHE, ">$cache_file" || die;
 251     print CACHE join "\x01", %translations;
 252     close CACHE;
 253 }
 254
 255 sub load_cache
 256 {
 257     print "Found cached translation database\n" unless $QUIET_ARG;
 258
 259     my $contents;
 260     open CACHE, "<$cache_file" || die;
 261     {
 262         local $/;
 263         $contents = <CACHE>;
 264     }
 265     close CACHE;
 266     %translations = split "\x01", $contents;
 267 }
 268
 269 sub get_cached_translation_database
 270 {
 271     my $cache_file_age = -M $cache_file;
 272     if (defined $cache_file_age) {
 273         if ($cache_file_age <= &get_newest_po_age) {
 274             &load_cache;
 275             return;
 276         }
 277         print "Found too-old cached translation database\n" unless $QUIET_ARG;
 278     }
 279
 280     &create_cache;
 281 }
 282
 283 sub create_translation_database
 284 {
 285     for my $lang (keys %po_files_by_lang) {
 286         my $po_file = $po_files_by_lang{$lang};
 287
 288         if ($UTF8_ARG) {
 289             my $encoding = get_po_encoding ($po_file);
 290             if (lc $encoding eq "utf-8") {
 291                 open PO_FILE, "<$po_file";
 292             } else {
 293                 my $iconv = $ENV{"INTLTOOL_ICONV"} || "iconv";
 294                 open PO_FILE, "$iconv -f $encoding -t UTF-8 $po_file|";
 295             }
 296         } else {
 297             open PO_FILE, "<$po_file";
 298         }
 299
 300         my $nextfuzzy = 0;
 301         my $inmsgid = 0;
 302         my $inmsgstr = 0;
 303         my $msgid = "";
 304         my $msgstr = "";
 305         while (<PO_FILE>) {
 306             $nextfuzzy = 1 if /^#, fuzzy/;
 307             if (/^msgid "((\\.|[^\\])*)"/ ) {
 308                 $translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr;
 309                 $msgid = "";
 310                 $msgstr = "";
 311
 312                 if ($nextfuzzy) {
 313                     $inmsgid = 0;
 314                 } else {
 315                     $msgid = unescape_po_string($1);
 316                     $inmsgid = 1;
 317                 }
 318                 $inmsgstr = 0;
 319                 $nextfuzzy = 0;
 320             }
 321             if (/^msgstr "((\\.|[^\\])*)"/) {
 322                 $msgstr = unescape_po_string($1);
 323                 $inmsgstr = 1;
 324                 $inmsgid = 0;
 325             }
 326             if (/^"((\\.|[^\\])*)"/) {
 327                 $msgid .= unescape_po_string($1) if $inmsgid;
 328                 $msgstr .= unescape_po_string($1) if $inmsgstr;
 329             }
 330         }
 331         $translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr;
 332     }
 333 }
 334
 335 sub finalize
 336 {
 337 }
 338
 339 sub unescape_one_sequence
 340 {
 341     my ($sequence) = @_;
 342
 343     return "\\" if $sequence eq "\\\\";
 344     return "\"" if $sequence eq "\\\"";
 345
 346     # gettext also handles \n, \t, \b, \r, \f, \v, \a, \xxx (octal),
 347     # \xXX (hex) and has a comment saying they want to handle \u and \U.
 348
 349     return $sequence;
 350 }
 351
 352 sub unescape_po_string
 353 {
 354     my ($string) = @_;
 355
 356     $string =~ s/(\\.)/unescape_one_sequence($1)/eg;
 357
 358     return $string;
 359 }
 360
 361 sub entity_decode
 362 {
 363     local ($_) = @_;
 364
 365     s/&apos;/'/g; # '
 366     s/&quot;/"/g; # "
 367     s/&amp;/&/g;
 368
 369     return $_;
 370 }
 371
 372 sub entity_encode
 373 {
 374     my ($pre_encoded) = @_;
 375
 376     my @list_of_chars = unpack ('C*', $pre_encoded);
 377
 378     if ($PASS_THROUGH_ARG) {
 379         return join ('', map (&entity_encode_int_even_high_bit, @list_of_chars));
 380     } else {
 381         return join ('', map (&entity_encode_int_minimalist, @list_of_chars));
 382     }
 383 }
 384
 385 sub entity_encode_int_minimalist
 386 {
 387     return "&quot;" if $_ == 34;
 388     return "&amp;" if $_ == 38;
 389     return "&apos;" if $_ == 39;
 390     return chr $_;
 391 }
 392
 393 sub entity_encode_int_even_high_bit
 394 {
 395     if ($_ > 127 || $_ == 34 || $_ == 38 || $_ == 39) {
 396         # the ($_ > 127) should probably be removed
 397         return "&#" . $_ . ";";
 398     } else {
 399         return chr $_;
 400     }
 401 }
 402
 403 sub entity_encoded_translation
 404 {
 405     my ($lang, $string) = @_;
 406
 407     my $translation = $translations{$lang, $string};
 408     return $string if !$translation;
 409     return entity_encode ($translation);
 410 }
 411
 412 ## XML (bonobo-activation specific) merge code
 413
 414 sub ba_merge_translations
 415 {
 416     my $source;
 417
 418     {
 419        local $/; # slurp mode
 420        open INPUT, "<$FILE" or die "can't open $FILE: $!";
 421        $source = <INPUT>;
 422        close INPUT;
 423     }
 424
 425     open OUTPUT, ">$OUTFILE" or die "can't open $OUTFILE: $!";
 426
 427     while ($source =~ s|^(.*?)([ \t]*<\s*$w+\s+($w+\s*=\s*"$q"\s*)+/?>)([ \t]*\n)?||s) {
 428         print OUTPUT $1;
 429
 430         my $node = $2 . "\n";
 431
 432         my @strings = ();
 433         $_ = $node;
 434         while (s/(\s)_($w+\s*=\s*"($q)")/$1$2/s) {
 435              push @strings, entity_decode($3);
 436         }
 437         print OUTPUT;
 438
 439         my %langs;
 440         for my $string (@strings) {
 441             for my $lang (keys %po_files_by_lang) {
 442                 $langs{$lang} = 1 if $translations{$lang, $string};
 443             }
 444         }
 445
 446         for my $lang (sort keys %langs) {
 447             $_ = $node;
 448             s/(\sname\s*=\s*)"($q)"/$1"$2-$lang"/s;
 449             s/(\s)_($w+\s*=\s*")($q)"/$1 . $2 . entity_encoded_translation($lang, $3) . '"'/seg;
 450             print OUTPUT;
 451         }
 452     }
 453
 454     print OUTPUT $source;
 455
 456     close OUTPUT;
 457 }
 458
 459
 460 ## XML (non-bonobo-activation) merge code
 461
 462 sub xml_merge_translations
 463 {
 464     my $source;
 465
 466     {
 467        local $/; # slurp mode
 468        open INPUT, "<$FILE" or die "can't open $FILE: $!";
 469        $source = <INPUT>;
 470        close INPUT;
 471     }
 472
 473     open OUTPUT, ">$OUTFILE" or die;
 474
 475     # FIXME: support attribute translations
 476
 477     # Empty nodes never need translation, so unmark all of them.
 478     # For example, <_foo/> is just replaced by <foo/>.
 479     $source =~ s|<\s*_($w+)\s*/>|<$1/>|g;
 480
 481     # Support for <_foo>blah</_foo> style translations.
 482     while ($source =~ s|^(.*?)([ \t]*)<\s*_($w+)\s*>(.*?)<\s*/_\3\s*>([ \t]*\n)?||s) {
 483         print OUTPUT $1;
 484
 485         my $spaces = $2;
 486         my $tag = $3;
 487         my $string = $4;
 488
 489         print OUTPUT "$spaces<$tag>$string</$tag>\n";
 490
 491         $string =~ s/\s+/ /g;
 492         $string =~ s/^ //;
 493         $string =~ s/ $//;
 494         $string = entity_decode($string);
 495
 496         for my $lang (sort keys %po_files_by_lang) {
 497             my $translation = $translations{$lang, $string};
 498             next if !$translation;
 499             $translation = entity_encode($translation);
 500             print OUTPUT "$spaces<$tag xml:lang=\"$lang\">$translation</$tag>\n";
 501         }
 502     }
 503
 504     print OUTPUT $source;
 505
 506     close OUTPUT;
 507 }
 508
 509 sub keys_merge_translations
 510 {
 511     open INPUT, "<${FILE}" or die;
 512     open OUTPUT, ">${OUTFILE}" or die;
 513
 514     while (<INPUT>) {
 515         if (s/^(\s*)_(\w+=(.*))/$1$2/)  {
 516             my $string = $3;
 517
 518             print OUTPUT;
 519
 520             my $non_translated_line = $_;
 521
 522             for my $lang (sort keys %po_files_by_lang) {
 523                 my $translation = $translations{$lang, $string};
 524                 next if !$translation;
 525
 526                 $_ = $non_translated_line;
 527                 s/(\w+)=.*/[$lang]$1=$translation/;
 528                 print OUTPUT;
 529             }
 530         } else {
 531             print OUTPUT;
 532         }
 533     }
 534
 535     close OUTPUT;
 536     close INPUT;
 537 }
 538
 539 sub desktop_merge_translations
 540 {
 541     open INPUT, "<${FILE}" or die;
 542     open OUTPUT, ">${OUTFILE}" or die;
 543
 544     while (<INPUT>) {
 545         if (s/^(\s*)_(\w+=(.*))/$1$2/)  {
 546             my $string = $3;
 547
 548             print OUTPUT;
 549
 550             my $non_translated_line = $_;
 551
 552             for my $lang (sort keys %po_files_by_lang) {
 553                 my $translation = $translations{$lang, $string};
 554                 next if !$translation;
 555
 556                 $_ = $non_translated_line;
 557                 s/(\w+)=.*/${1}[$lang]=$translation/;
 558                 print OUTPUT;
 559             }
 560         } else {
 561             print OUTPUT;
 562         }
 563     }
 564
 565     close OUTPUT;
 566     close INPUT;
 567 }