my $MSGID_BUGS_ADDRESS = &FindMakevarsBugAddress;    push @xgettext_argument, "--msgid-bugs-address\=\"$MSGID_BUGS_ADDRESS\"" if $MSGID_BUGS_ADDRESS;    push @xgettext_argument, "--from-code\=$encoding" if ($gettext_support_nonascii);    push @xgettext_argument, $XGETTEXT_ARGS if $XGETTEXT_ARGS;    my $xgettext_command = join ' ', @xgettext_argument;    # intercept xgettext error message    print "Running $xgettext_command\n" if $VERBOSE;    my $xgettext_error_msg = `$xgettext_command 2>\&1`;    my $command_failed = $?;    unlink "POTFILES.in.temp";    print "Removing generated header (.h) files..." if $VERBOSE;    unlink foreach (@temp_headers);    print "done.\n" if $VERBOSE;    if (! $command_failed)    {	if (! -e "$MODULE.pot")	{	    print "None of the files in POTFILES.in contain strings marked for translation.\n" if $VERBOSE;	}	else	{	    print "Wrote $MODULE.pot\n" if $VERBOSE;	}    }    else    {	if ($xgettext_error_msg =~ /--from-code/)	{	    # replace non-ASCII error message with a more useful one.	    print STDERR "ERROR: xgettext failed to generate PO template file because there is non-ASCII\n".			 "       string marked for translation. Please make sure that all strings marked\n".			 "       for translation are in uniform encoding (say UTF-8), then \e[1m*prepend*\e[0m the\n".			 "       following line to POTFILES.in and rerun $PROGRAM:\n\n".			 "           [encoding: UTF-8]\n\n";	}	else	{	    print STDERR "$xgettext_error_msg";	    if (-e "$MODULE.pot")	    {		# is this possible?		print STDERR "ERROR: xgettext failed but still managed to generate PO template file.\n".			     "       Please consult error message above if there is any.\n";	    }	    else	    {		print STDERR "ERROR: xgettext failed to generate PO template file. Please consult\n".			     "       error message above if there is any.\n";	    }	}	exit (1);    }}sub POFile_Update{    -f "$MODULE.pot" or die "$PROGRAM: $MODULE.pot does not exist.\n";    my $MSGMERGE = $ENV{"MSGMERGE"} || "msgmerge";    my ($lang, $outfile) = @_;    if (! isGNUGettextTool ("$MSGMERGE"))    {	print STDERR " *** GNU msgmerge is not found on this system!\n".		     " *** Without it, intltool-update can not extract strings.\n";	exit;    }    print "Merging $SRCDIR/$lang.po with $MODULE.pot..." if $VERBOSE;    my $infile = "$SRCDIR/$lang.po";    $outfile = "$SRCDIR/$lang.po" if ($outfile eq "");    # I think msgmerge won't overwrite old file if merge is not successful    system ("$MSGMERGE", "-o", $outfile, $infile, "$MODULE.pot");}sub Console_WriteError_NotExisting{    my ($file) = @_;    ## Report error if supplied language file is non-existing    print STDERR "$PROGRAM: $file does not exist!\n";    print STDERR "Try '$PROGRAM --help' for more information.\n";    exit;}sub GatherPOFiles{    my @po_files = glob ("./*.po");    @languages = map (&POFile_GetLanguage, @po_files);    foreach my $lang (@languages)     {	$po_files_by_lang{$lang} = shift (@po_files);    }}sub POFile_GetLanguage ($){    s/^(.*\/)?(.+)\.po$/$2/;    return $_;}sub Console_Write_TranslationStatus{    my ($lang, $output_file) = @_;    my $MSGFMT = $ENV{"MSGFMT"} || "msgfmt";    if (! isGNUGettextTool ("$MSGFMT"))    {	print STDERR " *** GNU msgfmt is not found on this system!\n".		     " *** Without it, intltool-update can not extract strings.\n";	exit;    }    $output_file = "$SRCDIR/$lang.po" if ($output_file eq "");    system ("$MSGFMT", "-o", "$devnull", "--verbose", $output_file);}sub Console_Write_CoverageReport{    my $MSGFMT = $ENV{"MSGFMT"} || "msgfmt";    if (! isGNUGettextTool ("$MSGFMT"))    {	print STDERR " *** GNU msgfmt is not found on this system!\n".		     " *** Without it, intltool-update can not extract strings.\n";	exit;    }    &GatherPOFiles;    foreach my $lang (@languages)     {	print STDERR "$lang: ";	&POFile_Update ($lang, "");    }    print STDERR "\n\n * Current translation support in $MODULE \n\n";    foreach my $lang (@languages)    {	print STDERR "$lang: ";	system ("$MSGFMT", "-o", "$devnull", "--verbose", "$SRCDIR/$lang.po");    }}sub SubstituteVariable{    my ($str) = @_;        # always need to rewind file whenever it has been accessed    seek (CONF, 0, 0);    # cache each variable. varhash is global to we can add    # variables elsewhere.    while (<CONF>)    {	if (/^(\w+)=(.*)$/)	{	    ($varhash{$1} = $2) =~  s/^["'](.*)["']$/$1/;	}    }        if ($str =~ /^(.*)\${?([A-Z_]+)}?(.*)$/)    {	my $rest = $3;	my $untouched = $1;	my $sub = "";        # Ignore recursive definitions of variables        $sub = $varhash{$2} if defined $varhash{$2} and $varhash{$2} !~ /\${?$2}?/;	return SubstituteVariable ("$untouched$sub$rest");    }        # We're using Perl backticks ` and "echo -n" here in order to     # expand any shell escapes (such as backticks themselves) in every variable    return echo_n ($str);}sub CONF_Handle_Open{    my $base_dirname = getcwd();    $base_dirname =~ s@.*/@@;    my ($conf_in, $src_dir);    if ($base_dirname =~ /^po(-.+)?$/)     {	if (-f "Makevars") 	{	    my $makefile_source;	    local (*IN);	    open (IN, "<Makevars") || die "can't open Makevars: $!";	    while (<IN>) 	    {		if (/^top_builddir[ \t]*=/) 		{		    $src_dir = $_;		    $src_dir =~ s/^top_builddir[ \t]*=[ \t]*([^ \t\n\r]*)/$1/;		    chomp $src_dir;                    if (-f "$src_dir" . "/configure.ac") {                        $conf_in = "$src_dir" . "/configure.ac" . "\n";                    } else {                        $conf_in = "$src_dir" . "/configure.in" . "\n";                    }		    last;		}	    }	    close IN;	    $conf_in || die "Cannot find top_builddir in Makevars.";	}	elsif (-f "$SRCDIR/../configure.ac") 	{	    $conf_in = "$SRCDIR/../configure.ac";	} 	elsif (-f "$SRCDIR/../configure.in") 	{	    $conf_in = "$SRCDIR/../configure.in";	} 	else 	{	    my $makefile_source;	    local (*IN);	    open (IN, "<Makefile") || return;	    while (<IN>) 	    {		if (/^top_srcdir[ \t]*=/) 		{		    $src_dir = $_;		    		    $src_dir =~ s/^top_srcdir[ \t]*=[ \t]*([^ \t\n\r]*)/$1/;		    chomp $src_dir;		    $conf_in = "$src_dir" . "/configure.in" . "\n";		    last;		}	    }	    close IN;	    $conf_in || die "Cannot find top_srcdir in Makefile.";	}	open (CONF, "<$conf_in");    }    else    {	print STDERR "$PROGRAM: Unable to proceed.\n" .		     "Make sure to run this script inside the po directory.\n";	exit;    }}sub FindPackageName{    my $version;    my $domain = &FindMakevarsDomain;    my $name = $domain || "untitled";    &CONF_Handle_Open;    my $conf_source; {	local (*IN);	open (IN, "<&CONF") || return $name;	seek (IN, 0, 0);	local $/; # slurp mode	$conf_source = <IN>;	close IN;    }    # priority for getting package name:    # 1. GETTEXT_PACKAGE    # 2. first argument of AC_INIT (with >= 2 arguments)    # 3. first argument of AM_INIT_AUTOMAKE (with >= 2 argument)    # /^AM_INIT_AUTOMAKE\([\s\[]*([^,\)\s\]]+)/m     # the \s makes this not work, why?    if ($conf_source =~ /^AM_INIT_AUTOMAKE\(([^,\)]+),([^,\)]+)/m)    {	($name, $version) = ($1, $2);	$name    =~ s/[\[\]\s]//g;	$version =~ s/[\[\]\s]//g;	$varhash{"PACKAGE_NAME"} = $name if (not $name =~ /\${?AC_PACKAGE_NAME}?/);	$varhash{"PACKAGE"} = $name if (not $name =~ /\${?PACKAGE}?/);	$varhash{"PACKAGE_VERSION"} = $version if (not $name =~ /\${?AC_PACKAGE_VERSION}?/);	$varhash{"VERSION"} = $version if (not $name =~ /\${?VERSION}?/);    }        if ($conf_source =~ /^AC_INIT\(([^,\)]+),([^,\)]+)/m)     {	($name, $version) = ($1, $2);	$name    =~ s/[\[\]\s]//g;	$version =~ s/[\[\]\s]//g;	$varhash{"PACKAGE_NAME"} = $name if (not $name =~ /\${?AC_PACKAGE_NAME}?/);	$varhash{"PACKAGE"} = $name if (not $name =~ /\${?PACKAGE}?/);	$varhash{"PACKAGE_VERSION"} = $version if (not $name =~ /\${?AC_PACKAGE_VERSION}?/);	$varhash{"VERSION"} = $version if (not $name =~ /\${?VERSION}?/);    }    # \s makes this not work, why?    $name = $1 if $conf_source =~ /^GETTEXT_PACKAGE=\[?([^\n\]]+)/m;        # m4 macros AC_PACKAGE_NAME, AC_PACKAGE_VERSION etc. have same value    # as corresponding $PACKAGE_NAME, $PACKAGE_VERSION etc. shell variables.    $name =~ s/\bAC_PACKAGE_/\$PACKAGE_/g;    $name = $domain if $domain;    $name = SubstituteVariable ($name);    $name =~ s/^["'](.*)["']$/$1/;    return $name if $name;}sub FindPOTKeywords{    my $keywords = "--keyword\=\_ --keyword\=N\_ --keyword\=U\_ --keyword\=Q\_";    my $varname = "XGETTEXT_OPTIONS";    my $make_source; {	local (*IN);	open (IN, "<Makevars") || (open(IN, "<Makefile.in.in") && ($varname = "XGETTEXT_KEYWORDS")) || return $keywords;	seek (IN, 0, 0);	local $/; # slurp mode	$make_source = <IN>;	close IN;    }    # unwrap lines split with a trailing \    $make_source =~  s/\\ $ \n/ /mxg;    $keywords = $1 if $make_source =~ /^$varname[ ]*=\[?([^\n\]]+)/m;        return $keywords;}sub FindMakevarsDomain{    my $domain = "";    my $makevars_source; { 	local (*IN);	open (IN, "<Makevars") || return $domain;	seek (IN, 0, 0);	local $/; # slurp mode	$makevars_source = <IN>;	close IN;    }    $domain = $1 if $makevars_source =~ /^DOMAIN[ ]*=\[?([^\n\]\$]+)/m;    $domain =~ s/^\s+//;    $domain =~ s/\s+$//;        return $domain;}sub FindMakevarsBugAddress{    my $address = "";    my $makevars_source; { 	local (*IN);	open (IN, "<Makevars") || return undef;	seek (IN, 0, 0);	local $/; # slurp mode	$makevars_source = <IN>;	close IN;    }    $address = $1 if $makevars_source =~ /^MSGID_BUGS_ADDRESS[ ]*=\[?([^\n\]\$]+)/m;    $address =~ s/^\s+//;    $address =~ s/\s+$//;        return $address;}