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