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