~ubuntu-branches/ubuntu/jaunty/transmission/jaunty-security

#!@INTLTOOL_PERL@ -w

# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4  -*-

#

#  The Intltool Message Merger

#

#  Copyright (C) 2000, 2003 Free Software Foundation.

#  Copyright (C) 2000, 2001 Eazel, Inc

#

#  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:  Maciej Stachowiak <mjs@noisehavoc.org>

#            Kenneth Christiansen <kenneth@gnu.org>

#            Darin Adler <darin@bentspoon.com>

#

#  Proper XML UTF-8'ification written by Cyrille Chepelov <chepelov@calixo.net>

#

## Release information

my $PROGRAM = "intltool-merge";

my $PACKAGE = "intltool";

my $VERSION = "0.36.2";

## Loaded modules

use strict; 

use Getopt::Long;

use Text::Wrap;

use File::Basename;

my $must_end_tag      = -1;

my $last_depth        = -1;

my $translation_depth = -1;

my @tag_stack = ();

my @entered_tag = ();

my @translation_strings = ();

my $leading_space = "";

## Scalars used by the option stuff

my $HELP_ARG = 0;

my $VERSION_ARG = 0;

my $BA_STYLE_ARG = 0;

my $XML_STYLE_ARG = 0;

my $KEYS_STYLE_ARG = 0;

my $DESKTOP_STYLE_ARG = 0;

my $SCHEMAS_STYLE_ARG = 0;

my $RFC822DEB_STYLE_ARG = 0;

my $QUOTED_STYLE_ARG = 0;

my $QUIET_ARG = 0;

my $PASS_THROUGH_ARG = 0;

my $UTF8_ARG = 0;

my $MULTIPLE_OUTPUT = 0;

my $cache_file;

## Handle options

GetOptions 

(

 "help" => \$HELP_ARG,

 "version" => \$VERSION_ARG,

 "quiet|q" => \$QUIET_ARG,

 "oaf-style|o" => \$BA_STYLE_ARG, ## for compatibility

 "ba-style|b" => \$BA_STYLE_ARG,

 "xml-style|x" => \$XML_STYLE_ARG,

 "keys-style|k" => \$KEYS_STYLE_ARG,

 "desktop-style|d" => \$DESKTOP_STYLE_ARG,

 "schemas-style|s" => \$SCHEMAS_STYLE_ARG,

 "rfc822deb-style|r" => \$RFC822DEB_STYLE_ARG,

 "quoted-style" => \$QUOTED_STYLE_ARG,

 "pass-through|p" => \$PASS_THROUGH_ARG,

 "utf8|u" => \$UTF8_ARG,

 "multiple-output|m" => \$MULTIPLE_OUTPUT,

 "cache|c=s" => \$cache_file

 ) or &error;

my $PO_DIR;

my $FILE;

my $OUTFILE;

my %po_files_by_lang = ();

my %translations = ();

my $iconv = $ENV{"ICONV"} || "iconv";

my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null');

sub isProgramInPath

{

    my ($file) = @_;

    # If either a file exists, or when run it returns 0 exit status

    return 1 if ((-x $file) or (system("$file -l >$devnull") == 0));

    return 0;

}

if (! isProgramInPath ("$iconv"))

{

	print STDERR " *** iconv is not found on this system!\n".

		     " *** Without it, intltool-merge can not convert encodings.\n";

	exit;

}

# Use this instead of \w for XML files to handle more possible characters.

my $w = "[-A-Za-z0-9._:]";

# XML quoted string contents

my $q = "[^\\\"]*";

## Check for options. 

if ($VERSION_ARG) 

{

	&print_version;

} 

elsif ($HELP_ARG) 

{

	&print_help;

} 

elsif ($BA_STYLE_ARG && @ARGV > 2) 

{

	&utf8_sanity_check;

	&preparation;

	&print_message;

	&ba_merge_translations;

	&finalize;

} 

elsif ($XML_STYLE_ARG && @ARGV > 2) 

{

	&utf8_sanity_check;

	&preparation;

	&print_message;

	&xml_merge_output;

	&finalize;

} 

elsif ($KEYS_STYLE_ARG && @ARGV > 2) 

{

	&utf8_sanity_check;

	&preparation;

	&print_message;

	&keys_merge_translations;

	&finalize;

} 

elsif ($DESKTOP_STYLE_ARG && @ARGV > 2) 

{

	&utf8_sanity_check;

	&preparation;

	&print_message;

	&desktop_merge_translations;

	&finalize;

} 

elsif ($SCHEMAS_STYLE_ARG && @ARGV > 2) 

{

	&utf8_sanity_check;

	&preparation;

	&print_message;

	&schemas_merge_translations;

	&finalize;

} 

elsif ($RFC822DEB_STYLE_ARG && @ARGV > 2) 

{

	&preparation;

	&print_message;

	&rfc822deb_merge_translations;

	&finalize;

} 

elsif ($QUOTED_STYLE_ARG && @ARGV > 2) 

{

	&utf8_sanity_check;

	&preparation;

	&print_message;

	&quoted_merge_translations;

	&finalize;

} 

else 

{

	&print_help;

}

exit;

## Sub for printing release information

sub print_version

{

    print <<_EOF_;

${PROGRAM} (${PACKAGE}) ${VERSION}

Written by Maciej Stachowiak, Darin Adler and Kenneth Christiansen.

Copyright (C) 2000-2003 Free Software Foundation, Inc.

Copyright (C) 2000-2001 Eazel, Inc.

This is free software; see the source for copying conditions.  There is NO

warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

_EOF_

    exit;

}

## Sub for printing usage information

sub print_help

{

    print <<_EOF_;

Usage: ${PROGRAM} [OPTION]... PO_DIRECTORY FILENAME OUTPUT_FILE

Generates an output file that includes some localized attributes from an

untranslated source file.

Mandatory options: (exactly one must be specified)

  -b, --ba-style         includes translations in the bonobo-activation style

  -d, --desktop-style    includes translations in the desktop style

  -k, --keys-style       includes translations in the keys style

  -s, --schemas-style    includes translations in the schemas style

  -r, --rfc822deb-style  includes translations in the RFC822 style

      --quoted-style     includes translations in the quoted string style

  -x, --xml-style        includes translations in the standard xml style

Other options:

  -u, --utf8             convert all strings to UTF-8 before merging 

                         (default for everything except RFC822 style)

  -p, --pass-through     deprecated, does nothing and issues a warning

  -m, --multiple-output  output one localized file per locale, instead of 

	                 a single file containing all localized elements

  -c, --cache=FILE       specify cache file name

                         (usually \$top_builddir/po/.intltool-merge-cache)

  -q, --quiet            suppress most messages

      --help             display this help and exit

      --version          output version information and exit

Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE")

or send email to <xml-i18n-tools\@gnome.org>.

_EOF_

    exit;

}

## Sub for printing error messages

sub print_error

{

    print STDERR "Try `${PROGRAM} --help' for more information.\n";

    exit;

}

sub print_message 

{

    print "Merging translations into $OUTFILE.\n" unless $QUIET_ARG;

}

sub preparation 

{

    $PO_DIR = $ARGV[0];

    $FILE = $ARGV[1];

    $OUTFILE = $ARGV[2];

    &gather_po_files;

    &get_translation_database;

}

# General-purpose code for looking up translations in .po files

sub po_file2lang

{

    my ($tmp) = @_; 

    $tmp =~ s/^.*\/(.*)\.po$/$1/; 

    return $tmp; 

}

sub gather_po_files

{

    if (my $linguas = $ENV{"LINGUAS"})

    {

        for my $lang (split / /, $linguas) {

            my $po_file = $PO_DIR . "/" . $lang . ".po";

            if (-e $po_file) {

                $po_files_by_lang{$lang} = $po_file;

            }

        }

    }

    else

    {

        if (open LINGUAS_FILE, "$PO_DIR/LINGUAS")

        {

            while (<LINGUAS_FILE>)

            {

                next if /^#/;

                if (/([-a-zA-Z_@.]+)\n/)

                {

                    my $lang = $1;

                    my $po_file = $PO_DIR . "/" . $lang . ".po";

                    if (-e $po_file) {

                        $po_files_by_lang{$lang} = $po_file;

                    }

                }

            }

            close LINGUAS_FILE;

        }

        else

        {

            for my $po_file (glob "$PO_DIR/*.po") {

                $po_files_by_lang{po_file2lang($po_file)} = $po_file;

            }

        }

    }

}

sub get_local_charset

{

    my ($encoding) = @_;

    my $alias_file = $ENV{"G_CHARSET_ALIAS"} || "@INTLTOOL_LIBDIR@/charset.alias";

    # seek character encoding aliases in charset.alias (glib)

    if (open CHARSET_ALIAS, $alias_file) 

    {

	while (<CHARSET_ALIAS>) 

        {

            next if /^\#/;

            return $1 if (/^\s*([-._a-zA-Z0-9]+)\s+$encoding\b/i)

        }

        close CHARSET_ALIAS;

    }

    # if not found, return input string

    return $encoding;

}

sub get_po_encoding

{

    my ($in_po_file) = @_;

    my $encoding = "";

    open IN_PO_FILE, $in_po_file or die;

    while (<IN_PO_FILE>) 

    {

        ## example: "Content-Type: text/plain; charset=ISO-8859-1\n"

        if (/Content-Type\:.*charset=([-a-zA-Z0-9]+)\\n/) 

        {

            $encoding = $1; 

            last;

        }

    }

    close IN_PO_FILE;

    if (!$encoding) 

    {

        print STDERR "Warning: no encoding found in $in_po_file. Assuming ISO-8859-1\n" unless $QUIET_ARG;

        $encoding = "ISO-8859-1";

    }

    system ("$iconv -f $encoding -t UTF-8 <$devnull 2>$devnull");

    if ($?) {

	$encoding = get_local_charset($encoding);

    }

    return $encoding

}

sub utf8_sanity_check 

{

    print STDERR "Warning: option --pass-through has been removed.\n" if $PASS_THROUGH_ARG;

    $UTF8_ARG = 1;

}

sub get_translation_database

{

    if ($cache_file) {

	&get_cached_translation_database;

    } else {

        &create_translation_database;

    }

}

sub get_newest_po_age

{

    my $newest_age;

    foreach my $file (values %po_files_by_lang) 

    {

	my $file_age = -M $file;

	$newest_age = $file_age if !$newest_age || $file_age < $newest_age;

    }

    $newest_age = 0 if !$newest_age;

    return $newest_age;

}

sub create_cache

{

    print "Generating and caching the translation database\n" unless $QUIET_ARG;

    &create_translation_database;

    open CACHE, ">$cache_file" || die;

    print CACHE join "\x01", %translations;

    close CACHE;

}

sub load_cache 

{

    print "Found cached translation database\n" unless $QUIET_ARG;

    my $contents;

    open CACHE, "<$cache_file" || die;

    {

        local $/;

        $contents = <CACHE>;

    }

    close CACHE;

    %translations = split "\x01", $contents;

}

sub get_cached_translation_database

{

    my $cache_file_age = -M $cache_file;

    if (defined $cache_file_age) 

    {

        if ($cache_file_age <= &get_newest_po_age) 

        {

            &load_cache;

            return;

        }

        print "Found too-old cached translation database\n" unless $QUIET_ARG;

    }

    &create_cache;

}

sub create_translation_database

{

    for my $lang (keys %po_files_by_lang) 

    {

    	my $po_file = $po_files_by_lang{$lang};

        if ($UTF8_ARG) 

        {

            my $encoding = get_po_encoding ($po_file);

            if (lc $encoding eq "utf-8") 

            {

                open PO_FILE, "<$po_file";	

            } 

            else 

            {

		print "NOTICE: $po_file is not in UTF-8 but $encoding, converting...\n" unless $QUIET_ARG;;

                open PO_FILE, "$iconv -f $encoding -t UTF-8 $po_file|";	

            }

        } 

        else 

        {

            open PO_FILE, "<$po_file";	

        }

	my $nextfuzzy = 0;

	my $inmsgid = 0;

	my $inmsgstr = 0;

	my $msgid = "";

	my $msgstr = "";

        while (<PO_FILE>) 

        {

	    $nextfuzzy = 1 if /^#, fuzzy/;

	    if (/^msgid "((\\.|[^\\]+)*)"/ ) 

            {

		$translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr;

		$msgid = "";

		$msgstr = "";

		if ($nextfuzzy) {

		    $inmsgid = 0;

		} else {

		    $msgid = unescape_po_string($1);

		    $inmsgid = 1;

		}

		$inmsgstr = 0;

		$nextfuzzy = 0;

	    }

	    if (/^msgstr "((\\.|[^\\]+)*)"/) 

            {

	        $msgstr = unescape_po_string($1);

		$inmsgstr = 1;

		$inmsgid = 0;

	    }

	    if (/^"((\\.|[^\\]+)*)"/) 

            {

	        $msgid .= unescape_po_string($1) if $inmsgid;

	        $msgstr .= unescape_po_string($1) if $inmsgstr;

	    }

	}

	$translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr;

    }

}

sub finalize

{

}

sub unescape_one_sequence

{

    my ($sequence) = @_;

    return "\\" if $sequence eq "\\\\";

    return "\"" if $sequence eq "\\\"";

    return "\n" if $sequence eq "\\n";

    return "\r" if $sequence eq "\\r";

    return "\t" if $sequence eq "\\t";

    return "\b" if $sequence eq "\\b";

    return "\f" if $sequence eq "\\f";

    return "\a" if $sequence eq "\\a";

    return chr(11) if $sequence eq "\\v"; # vertical tab, see ascii(7)

    return chr(hex($1)) if ($sequence =~ /\\x([0-9a-fA-F]{2})/);

    return chr(oct($1)) if ($sequence =~ /\\([0-7]{3})/);

    # FIXME: Is \0 supported as well? Kenneth and Rodney don't want it, see bug #48489

    return $sequence;

}

sub unescape_po_string

{

    my ($string) = @_;

    $string =~ s/(\\x[0-9a-fA-F]{2}|\\[0-7]{3}|\\.)/unescape_one_sequence($1)/eg;

    return $string;

}

sub entity_decode

{

    local ($_) = @_;

    s/'/'/g; # '

    s/"/"/g; # "

    s/&lt;/</g;

    s/>/>/g;

    s/&/&/g;

    return $_;

}

# entity_encode: (string)

#

# Encode the given string to XML format (encode '<' etc).

sub entity_encode

{

    my ($pre_encoded) = @_;

    my @list_of_chars = unpack ('C*', $pre_encoded);

    # with UTF-8 we only encode minimalistic

    return join ('', map (&entity_encode_int_minimalist, @list_of_chars));

}

sub entity_encode_int_minimalist

{

    return """ if $_ == 34;

    return "&" if $_ == 38;

    return "'" if $_ == 39;

    return "<" if $_ == 60;

    return chr $_;

}

sub entity_encoded_translation

{

    my ($lang, $string) = @_;

    my $translation = $translations{$lang, $string};

    return $string if !$translation;

    return entity_encode ($translation);

}

## XML (bonobo-activation specific) merge code

sub ba_merge_translations

{

    my $source;

    {

       local $/; # slurp mode

       open INPUT, "<$FILE" or die "can't open $FILE: $!";

       $source = <INPUT>;

       close INPUT;

    }

    open OUTPUT, ">$OUTFILE" or die "can't open $OUTFILE: $!";

    # Binmode so that selftest works ok if using a native Win32 Perl...

    binmode (OUTPUT) if $^O eq 'MSWin32';

    while ($source =~ s|^(.*?)([ \t]*<\s*$w+\s+($w+\s*=\s*"$q"\s*)+/?>)([ \t]*\n)?||s) 

    {

        print OUTPUT $1;

        my $node = $2 . "\n";

        my @strings = ();

        $_ = $node;

	while (s/(\s)_($w+\s*=\s*"($q)")/$1$2/s) {

             push @strings, entity_decode($3);

        }

	print OUTPUT;

	my %langs;

	for my $string (@strings) 

        {

	    for my $lang (keys %po_files_by_lang) 

            {

                $langs{$lang} = 1 if $translations{$lang, $string};

	    }

	}

	for my $lang (sort keys %langs) 

        {

	    $_ = $node;

	    s/(\sname\s*=\s*)"($q)"/$1"$2-$lang"/s;

	    s/(\s)_($w+\s*=\s*")($q)"/$1 . $2 . entity_encoded_translation($lang, $3) . '"'/seg;

	    print OUTPUT;

        }

    }

    print OUTPUT $source;

    close OUTPUT;

}

## XML (non-bonobo-activation) merge code

# Process tag attributes

#   Only parameter is a HASH containing attributes -> values mapping

sub getAttributeString

{

    my $sub = shift;

    my $do_translate = shift || 0;

    my $language = shift || "";

    my $result = "";

    my $translate = shift;

    foreach my $e (reverse(sort(keys %{ $sub }))) {

	my $key    = $e;

	my $string = $sub->{$e};

	my $quote = '"';

	$string =~ s/^[\s]+//;

	$string =~ s/[\s]+$//;

	if ($string =~ /^'.*'$/)

	{

	    $quote = "'";

	}

	$string =~ s/^['"]//g;

	$string =~ s/['"]$//g;

	if ($do_translate && $key =~ /^_/) {

	    $key =~ s|^_||g;

	    if ($language) {

		# Handle translation

		my $decode_string = entity_decode($string);

		my $translation = $translations{$language, $decode_string};

		if ($translation) {

		    $translation = entity_encode($translation);

		    $string = $translation;

                }

                $$translate = 2;

            } else {

                 $$translate = 2 if ($translate && (!$$translate)); # watch not to "overwrite" $translate

            }

	}

	$result .= " $key=$quote$string$quote";

    }

    return $result;

}

# Returns a translatable string from XML node, it works on contents of every node in XML::Parser tree

sub getXMLstring

{

    my $ref = shift;

    my $spacepreserve = shift || 0;

    my @list = @{ $ref };

    my $result = "";

    my $count = scalar(@list);

    my $attrs = $list[0];

    my $index = 1;

    $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));

    $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));

    while ($index < $count) {

	my $type = $list[$index];

	my $content = $list[$index+1];

        if (! $type ) {

	    # We've got CDATA

	    if ($content) {

		# lets strip the whitespace here, and *ONLY* here

                $content =~ s/\s+/ /gs if (!$spacepreserve);

		$result .= $content;

	    }

	} elsif ( "$type" ne "1" ) {

	    # We've got another element

	    $result .= "<$type";

	    $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements

	    if ($content) {

		my $subresult = getXMLstring($content, $spacepreserve);

		if ($subresult) {

		    $result .= ">".$subresult . "</$type>";

		} else {

		    $result .= "/>";

		}

	    } else {

		$result .= "/>";

	    }

	}

	$index += 2;

    }

    return $result;

}

# Translate list of nodes if necessary

sub translate_subnodes

{

    my $fh = shift;

    my $content = shift;

    my $language = shift || "";

    my $singlelang = shift || 0;

    my $spacepreserve = shift || 0;

    my @nodes = @{ $content };

    my $count = scalar(@nodes);

    my $index = 0;

    while ($index < $count) {

        my $type = $nodes[$index];

        my $rest = $nodes[$index+1];

        if ($singlelang) {

            my $oldMO = $MULTIPLE_OUTPUT;

            $MULTIPLE_OUTPUT = 1;

            traverse($fh, $type, $rest, $language, $spacepreserve);

            $MULTIPLE_OUTPUT = $oldMO;

        } else {

            traverse($fh, $type, $rest, $language, $spacepreserve);