"Fossies" - the Fresh Open Source Software Archive

Member "firestarter-1.0.3/intltool-update.in" (29 Jan 2005, 25634 Bytes) of package /linux/misc/old/firestarter-1.0.3.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

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