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