#!@INTLTOOL_PERL@ -w# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4  -*-##  The Intltool Message Updater##  Copyright (C) 2000-2003 Free Software Foundation.##  Intltool is free software; you can redistribute it and/or#  modify it under the terms of the GNU General Public License #  version 2 published by the Free Software Foundation.##  Intltool is distributed in the hope that it will be useful,#  but WITHOUT ANY WARRANTY; without even the implied warranty of#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU#  General Public License for more details.##  You should have received a copy of the GNU General Public License#  along with this program; if not, write to the Free Software#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.##  As a special exception to the GNU General Public License, if you#  distribute this file as part of a program that contains a#  configuration script generated by Autoconf, you may include it under#  the same distribution terms that you use for the rest of that program.##  Authors: Kenneth Christiansen <kenneth@gnu.org>#           Maciej Stachowiak#           Darin Adler <darin@bentspoon.com>## Release informationmy $PROGRAM = "intltool-update";my $VERSION = "0.35.0";my $PACKAGE = "intltool";## Loaded modulesuse strict;use Getopt::Long;use Cwd;use File::Copy;use File::Find;## Scalars used by the option stuffmy $HELP_ARG 	   = 0;my $VERSION_ARG    = 0;my $DIST_ARG	   = 0;my $POT_ARG	   = 0;my $HEADERS_ARG    = 0;my $MAINTAIN_ARG   = 0;my $REPORT_ARG     = 0;my $VERBOSE	   = 0;my $GETTEXT_PACKAGE = "";my $OUTPUT_FILE    = "";my @languages;my %varhash = ();my %po_files_by_lang = ();# Regular expressions to categorize file types.# FIXME: Please check if the following is correctmy $xml_support ="xml(?:\\.in)*|".	# http://www.w3.org/XML/ (Note: .in is not required)"ui|".			# Bonobo specific - User Interface desc. files"lang|".		# ?"glade2?(?:\\.in)*|".	# Glade specific - User Interface desc. files (Note: .in is not required)"scm(?:\\.in)*|".	# ? (Note: .in is not required)"oaf(?:\\.in)+|".	# DEPRECATED: Replaces by Bonobo .server files "etspec|".		# ?"server(?:\\.in)+|".	# Bonobo specific"sheet(?:\\.in)+|".	# ?"schemas(?:\\.in)+|".	# GConf specific"pong(?:\\.in)+|".	# DEPRECATED: PONG is not used [by GNOME] any longer."kbd(?:\\.in)+";	# GOK specific. my $ini_support ="icon(?:\\.in)+|".	# http://www.freedesktop.org/Standards/icon-theme-spec"desktop(?:\\.in)+|".	# http://www.freedesktop.org/Standards/menu-spec"caves(?:\\.in)+|".	# GNOME Games specific"directory(?:\\.in)+|".	# http://www.freedesktop.org/Standards/menu-spec"soundlist(?:\\.in)+|".	# GNOME specific"keys(?:\\.in)+|".	# GNOME Mime database specific"theme(?:\\.in)+|".	# http://www.freedesktop.org/Standards/icon-theme-spec"service(?:\\.in)+";    # DBus specificmy $buildin_gettext_support = "c|y|cs|cc|cpp|c\\+\\+|h|hh|gob|py";## Always flush buffer when printing$| = 1;## Sometimes the source tree will be rooted somewhere else.my $SRCDIR = ".";my $POTFILES_in;$SRCDIR = $ENV{"srcdir"} if $ENV{"srcdir"};$POTFILES_in = "<$SRCDIR/POTFILES.in";my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null');## Handle optionsGetOptions ( "help" 	       => \$HELP_ARG, "version" 	       => \$VERSION_ARG, "dist|d"	       => \$DIST_ARG, "pot|p"	       => \$POT_ARG, "headers|s"	       => \$HEADERS_ARG, "maintain|m"	       => \$MAINTAIN_ARG, "report|r"	       => \$REPORT_ARG, "verbose|x"	       => \$VERBOSE, "gettext-package|g=s" => \$GETTEXT_PACKAGE, "output-file|o=s"     => \$OUTPUT_FILE, ) or &Console_WriteError_InvalidOption;&Console_Write_IntltoolHelp if $HELP_ARG;&Console_Write_IntltoolVersion if $VERSION_ARG;my $arg_count = ($DIST_ARG > 0)    + ($POT_ARG > 0)    + ($HEADERS_ARG > 0)    + ($MAINTAIN_ARG > 0)    + ($REPORT_ARG > 0);&Console_Write_IntltoolHelp if $arg_count > 1;# --version and --help don't require a module namemy $MODULE = $GETTEXT_PACKAGE || &FindPackageName || "unknown";if ($POT_ARG){    &GenerateHeaders;    &GeneratePOTemplate;}elsif ($HEADERS_ARG){    &GenerateHeaders;}elsif ($MAINTAIN_ARG){    &FindLeftoutFiles;}elsif ($REPORT_ARG){    &GenerateHeaders;    &GeneratePOTemplate;    &Console_Write_CoverageReport;}elsif ((defined $ARGV[0]) && $ARGV[0] =~ /^[a-z]/){    my $lang = $ARGV[0];    ## Report error if the language file supplied    ## to the command line is non-existent    &Console_WriteError_NotExisting("$SRCDIR/$lang.po")        if ! -s "$SRCDIR/$lang.po";    if (!$DIST_ARG)    {	print "Working, please wait..." if $VERBOSE;	&GenerateHeaders;	&GeneratePOTemplate;    }    &POFile_Update ($lang, $OUTPUT_FILE);    &Console_Write_TranslationStatus ($lang, $OUTPUT_FILE);} else {    &Console_Write_IntltoolHelp;}exit;#########sub Console_Write_IntltoolVersion{    print <<_EOF_;${PROGRAM} (${PACKAGE}) $VERSIONWritten by Kenneth Christiansen, Maciej Stachowiak, and Darin Adler.Copyright (C) 2000-2003 Free Software Foundation, Inc.This is free software; see the source for copying conditions.  There is NOwarranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE._EOF_    exit;}sub Console_Write_IntltoolHelp{    print <<_EOF_;Usage: ${PROGRAM} [OPTION]... LANGCODEUpdates PO template files and merge them with the translations.Mode of operation (only one is allowed):  -p, --pot                   generate the PO template only  -s, --headers               generate the header files in POTFILES.in  -m, --maintain              search for left out files from POTFILES.in  -r, --report                display a status report for the module  -d, --dist                  merge LANGCODE.po with existing PO templateExtra options:  -g, --gettext-package=NAME  override PO template name, useful with --pot  -o, --output-file=FILE      write merged translation to FILE  -x, --verbose               display lots of feedback      --help                  display this help and exit      --version               output version information and exitExamples of use:${PROGRAM} --pot    just create a new PO template${PROGRAM} xy       create new PO template and merge xy.po with itReport bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE")or send email to <xml-i18n-tools\@gnome.org>._EOF_    exit;}sub echo_n{    my $str = shift;    my $ret = `echo "$str"`;    $ret =~ s/\n$//; # do we need the "s" flag?    return $ret;}sub POFile_DetermineType ($) {   my $type = $_;   my $gettext_type;   my $xml_regex     = "(?:" . $xml_support . ")";   my $ini_regex     = "(?:" . $ini_support . ")";   my $buildin_regex = "(?:" . $buildin_gettext_support . ")";   if ($type =~ /\[type: gettext\/([^\]].*)]/)    {	$gettext_type=$1;   }   elsif ($type =~ /schemas(\.in)+$/)    {	$gettext_type="schemas";   }   elsif ($type =~ /glade2?(\.in)*$/)    {       $gettext_type="glade";   }   elsif ($type =~ /scm(\.in)*$/)    {       $gettext_type="scheme";   }   elsif ($type =~ /keys(\.in)+$/)    {       $gettext_type="keys";   }   # bucket types   elsif ($type =~ /$xml_regex$/)    {       $gettext_type="xml";   }   elsif ($type =~ /$ini_regex$/)    {        $gettext_type="ini";   }   elsif ($type =~ /$buildin_regex$/)    {       $gettext_type="buildin";   }   else   {        $gettext_type="unknown";    }   return "gettext\/$gettext_type";}sub TextFile_DetermineEncoding ($) {    my $gettext_code="ASCII"; # All files are ASCII by default    my $filetype=`file $_ | cut -d ' ' -f 2`;    if ($? eq "0")    {	if ($filetype =~ /^(ISO|UTF)/)	{	    chomp ($gettext_code = $filetype);	}	elsif ($filetype =~ /^XML/)	{	    $gettext_code="UTF-8"; # We asume that .glade and other .xml files are UTF-8	}    }    return $gettext_code;}sub isNotValidMissing{    my ($file) = @_;    return if $file =~ /^\{arch\}\/.*$/;    return if $file =~ /^$varhash{"PACKAGE"}-$varhash{"VERSION"}\/.*$/;}sub FindLeftoutFiles{    my (@buf_i18n_plain,	@buf_i18n_xml,	@buf_i18n_xml_unmarked,	@buf_i18n_ini,	@buf_potfiles,	@buf_potfiles_ignore,	@buf_allfiles,	@buf_allfiles_sorted,	@buf_potfiles_sorted    );    ## Search and find all translatable files    find sub { 	push @buf_i18n_plain,        "$File::Find::name" if /\.($buildin_gettext_support)$/;	push @buf_i18n_xml,          "$File::Find::name" if /\.($xml_support)$/;	push @buf_i18n_ini,          "$File::Find::name" if /\.($ini_support)$/;	push @buf_i18n_xml_unmarked, "$File::Find::name" if /\.(schemas(\.in)+)$/;	}, "..";    open POTFILES, $POTFILES_in or die "$PROGRAM:  there's no POTFILES.in!\n";    @buf_potfiles = grep !/^(#|\s*$)/, <POTFILES>;    close POTFILES;    foreach (@buf_potfiles) {	s/^\[.*]\s*//;    }    print "Searching for missing translatable files...\n" if $VERBOSE;    ## Check if we should ignore some found files, when    ## comparing with POTFILES.in    foreach my $ignore ("POTFILES.skip", "POTFILES.ignore")    {	(-s $ignore) or next;	if ("$ignore" eq "POTFILES.ignore")	{	    print "The usage of POTFILES.ignore is deprecated. Please consider moving the\n".		  "content of this file to POTFILES.skip.\n";	}	print "Found $ignore: Ignoring files...\n" if $VERBOSE;	open FILE, "<$ignore" or die "ERROR: Failed to open $ignore!\n";	    	while (<FILE>)	{	    push @buf_potfiles_ignore, $_ unless /^(#|\s*$)/;	}	close FILE;	@buf_potfiles = (@buf_potfiles_ignore, @buf_potfiles);    }    foreach my $file (@buf_i18n_plain)    {	my $in_comment = 0;	my $in_macro = 0;	open FILE, "<$file";	while (<FILE>)	{	    # Handle continued multi-line comment.	    if ($in_comment)	    {		next unless s-.*\*/--;		$in_comment = 0;	    }	    # Handle continued macro.	    if ($in_macro)	    {		$in_macro = 0 unless /\\$/;		next;	    }	    # Handle start of macro (or any preprocessor directive).	    if (/^\s*\#/)	    {		$in_macro = 1 if /^([^\\]|\\.)*\\$/;		next;	    }	    # Handle comments and quoted text.	    while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy	    {		my $match = $1;		if ($match eq "/*")		{		    if (!s-/\*.*?\*/--)		    {			s-/\*.*--;			$in_comment = 1;		    }		}		elsif ($match eq "//")		{		    s-//.*--;		}		else # ' or "		{		    if (!s-$match([^\\]|\\.)*?$match-QUOTEDTEXT-)		    {			warn "mismatched quotes at line $. in $file\n";			s-$match.*--;		    }		}	    }	    	    if (/\.GetString ?\(QUOTEDTEXT/)	    {                if (defined isNotValidMissing (unpack("x3 A*", $file))) {                    ## Remove the first 3 chars and add newline                    push @buf_allfiles, unpack("x3 A*", $file) . "\n";                }		last;	    }	    if (/_\(QUOTEDTEXT/)	    {                if (defined isNotValidMissing (unpack("x3 A*", $file))) {                    ## Remove the first 3 chars and add newline                    push @buf_allfiles, unpack("x3 A*", $file) . "\n";                }		last;	    }	}	close FILE;    }    foreach my $file (@buf_i18n_xml)     {	open FILE, "<$file";		while (<FILE>) 	{	    # FIXME: share the pattern matching code with intltool-extract	    if (/\s_[-A-Za-z0-9._:]+\s*=\s*\"([^"]+)\"/ || /<_[^>]+>/ || /translatable=\"yes\"/)	    {                if (defined isNotValidMissing (unpack("x3 A*", $file))) {                    push @buf_allfiles, unpack("x3 A*", $file) . "\n";                }		last;	    }	}	close FILE;    }    foreach my $file (@buf_i18n_ini)    {	open FILE, "<$file";	while (<FILE>) 	{	    if (/_(.*)=/)	    {                if (defined isNotValidMissing (unpack("x3 A*", $file))) {                    push @buf_allfiles, unpack("x3 A*", $file) . "\n";                }		last;	    }	}	close FILE;    }    foreach my $file (@buf_i18n_xml_unmarked)    {        if (defined isNotValidMissing (unpack("x3 A*", $file))) {            push @buf_allfiles, unpack("x3 A*", $file) . "\n";        }    }    @buf_allfiles_sorted = sort (@buf_allfiles);    @buf_potfiles_sorted = sort (@buf_potfiles);    my %in2;    foreach (@buf_potfiles_sorted)     {	$in2{$_} = 1;    }    my @result;    foreach (@buf_allfiles_sorted)    {	if (!exists($in2{$_}))	{	    push @result, $_	}    }    my @buf_potfiles_notexist;    foreach (@buf_potfiles_sorted)    {	chomp (my $dummy = $_);	if ("$dummy" ne "" and ! -f "../$dummy")	{	    push @buf_potfiles_notexist, $_;	}    }    ## Save file with information about the files missing    ## if any, and give information about this procedure.    if (@result + @buf_potfiles_notexist > 0)    {	if (@result) 	{	    print "\n" if $VERBOSE;	    unlink "missing";	    open OUT, ">missing";	    print OUT @result;	    close OUT;	    warn "\e[1mThe following files contain translations and are currently not in use. Please\e[0m\n".	         "\e[1mconsider adding these to the POTFILES.in file, located in the po/ directory.\e[0m\n\n";	    print STDERR @result, "\n";	    warn "If some of these files are left out on purpose then please add them to\n".		 "POTFILES.skip instead of POTFILES.in. A file \e[1m'missing'\e[0m containing this list\n".		 "of left out files has been written in the current directory.\n";	}	if (@buf_potfiles_notexist)	{	    unlink "notexist";	    open OUT, ">notexist";	    print OUT @buf_potfiles_notexist;	    close OUT;	    warn "\n" if ($VERBOSE or @result);	    warn "\e[1mThe following files do not exist anymore:\e[0m\n\n";	    warn @buf_potfiles_notexist, "\n";	    warn "Please remove them from POTFILES.in or POTFILES.skip. A file \e[1m'notexist'\e[0m\n".		 "containing this list of absent files has been written in the current directory.\n";	}    }    ## If there is nothing to complain about, notify the user