"Fossies" - the Fresh Open Source Software Archive

Member "evolution-brutus-1.2.35/intltool-update.in" (9 Mar 2009, 30998 Bytes) of archive /linux/misc/old/evolution-brutus-1.2.35.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.37.1";
   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 "policy(?:\\.in)+";	# PolicyKit files
   76 
   77 my $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 
   87 my $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.
   94 my $SRCDIR = $ENV{"srcdir"} || ".";
   95 my $POTFILES_in;
   96 
   97 $POTFILES_in = "<$SRCDIR/POTFILES.in";
   98 
   99 my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null');
  100 
  101 ## Handle options
  102 GetOptions 
  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 
  119 my $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 my $PKGNAME = FindPackageName ();
  128 
  129 # --version and --help don't require a module name
  130 my $MODULE = $GETTEXT_PACKAGE || $PKGNAME || "unknown";
  131 
  132 if ($POT_ARG)
  133 {
  134     &GenerateHeaders;
  135     &GeneratePOTemplate;
  136 }
  137 elsif ($HEADERS_ARG)
  138 {
  139     &GenerateHeaders;
  140 }
  141 elsif ($MAINTAIN_ARG)
  142 {
  143     &FindLeftoutFiles;
  144 }
  145 elsif ($REPORT_ARG)
  146 {
  147     &GenerateHeaders;
  148     &GeneratePOTemplate;
  149     &Console_Write_CoverageReport;
  150 }
  151 elsif ((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 } 
  169 else 
  170 {
  171     &Console_Write_IntltoolHelp;
  172 }
  173 
  174 exit;
  175 
  176 #########
  177 
  178 sub Console_Write_IntltoolVersion
  179 {
  180     print <<_EOF_;
  181 ${PROGRAM} (${PACKAGE}) $VERSION
  182 Written by Kenneth Christiansen, Maciej Stachowiak, and Darin Adler.
  183 
  184 Copyright (C) 2000-2003 Free Software Foundation, Inc.
  185 This is free software; see the source for copying conditions.  There is NO
  186 warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  187 _EOF_
  188     exit;
  189 }
  190 
  191 sub Console_Write_IntltoolHelp
  192 {
  193     print <<_EOF_;
  194 Usage: ${PROGRAM} [OPTION]... LANGCODE
  195 Updates PO template files and merge them with the translations.
  196 
  197 Mode 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 
  204 Extra 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 
  211 Examples 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 
  215 Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE")
  216 or send email to <xml-i18n-tools\@gnome.org>.
  217 _EOF_
  218     exit;
  219 }
  220 
  221 sub 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 
  231 sub 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 
  283 sub 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 
  303 sub isNotValidMissing
  304 {
  305     my ($file) = @_;
  306 
  307     return if $file =~ /^\{arch\}\/.*$/;
  308     return if $file =~ /^$varhash{"PACKAGE"}-$varhash{"VERSION"}\/.*$/;
  309 }
  310 
  311 sub 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/.." if "$SRCDIR" ne ".";
  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             ## C_ N_ Q_ and _ are the macros defined in gi8n.h
  438 	    if (/[CNQ]?_ *\(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 
  576 sub Console_WriteError_InvalidOption
  577 {
  578     ## Handle invalid arguments
  579     print STDERR "Try `${PROGRAM} --help' for more information.\n";
  580     exit 1;
  581 }
  582 
  583 sub 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 
  591 sub 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 
  603 sub 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 #
  654 sub 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 
  837 sub 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 
  860 sub 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 
  870 sub 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 
  882 sub POFile_GetLanguage ($)
  883 {
  884     s/^(.*\/)?(.+)\.po$/$2/;
  885     return $_;
  886 }
  887 
  888 sub 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 
  905 sub 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 
  933 sub 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 
  966 sub 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 
 1045 sub 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 
 1107 sub 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     # unwrap lines split with a trailing \
 1122     $make_source =~  s/\\ $ \n/ /mxg;
 1123     $keywords = $1 if $make_source =~ /^$varname[ ]*=\[?([^\n\]]+)/m;
 1124     
 1125     return $keywords;
 1126 }
 1127 
 1128 sub FindMakevarsDomain
 1129 {
 1130 
 1131     my $domain = "";
 1132     my $makevars_source; { 
 1133 	local (*IN);
 1134 	open (IN, "<Makevars") || return $domain;
 1135 	seek (IN, 0, 0);
 1136 	local $/; # slurp mode
 1137 	$makevars_source = <IN>;
 1138 	close IN;
 1139     }
 1140 
 1141     $domain = $1 if $makevars_source =~ /^DOMAIN[ ]*=\[?([^\n\]\$]+)/m;
 1142     $domain =~ s/^\s+//;
 1143     $domain =~ s/\s+$//;
 1144     
 1145     return $domain;
 1146 }
 1147 
 1148 sub FindMakevarsBugAddress
 1149 {
 1150 
 1151     my $address = "";
 1152     my $makevars_source; { 
 1153 	local (*IN);
 1154 	open (IN, "<Makevars") || return undef;
 1155 	seek (IN, 0, 0);
 1156 	local $/; # slurp mode
 1157 	$makevars_source = <IN>;
 1158 	close IN;
 1159     }
 1160 
 1161     $address = $1 if $makevars_source =~ /^MSGID_BUGS_ADDRESS[ ]*=\[?([^\n\]\$]+)/m;
 1162     $address =~ s/^\s+//;
 1163     $address =~ s/\s+$//;
 1164     
 1165     return $address;
 1166 }