intltool-merge.in

linux手机上的phonebook代码

       
	    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";

    # gettext also handles \n, \t, \b, \r, \f, \v, \a, \xxx (octal),
    # \xXX (hex) and has a comment saying they want to handle \u and \U.

    return $sequence;
}

sub unescape_po_string
{
    my ($string) = @_;

    $string =~ s/(\\.)/unescape_one_sequence($1)/eg;

    return $string;
}

## NOTE: deal with < - &lt; but not > - &gt;  because it seems its ok to have 
## > in the entity. For further info please look at #84738.
sub entity_decode
{
    local ($_) = @_;

    s/&apos;/'/g; # '
    s/&quot;/"/g; # "
    s/&amp;/&/g;
    s/&lt;/</g;

    return $_;
}
 
# entity_encode: (string)
#
# Encode the given string to XML format (encode '<' etc). It also 
# encodes high bit if not in UTF-8 mode.

sub entity_encode
{
    my ($pre_encoded) = @_;

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

    if ($PASS_THROUGH_ARG) 
    {
        return join ('', map (&entity_encode_int_even_high_bit, @list_of_chars));
    } 
    else 
    {
	# with UTF-8 we only encode minimalistic
        return join ('', map (&entity_encode_int_minimalist, @list_of_chars));
    }
}

sub entity_encode_int_minimalist
{
    return "&quot;" if $_ == 34;
    return "&amp;" if $_ == 38;
    return "&apos;" if $_ == 39;
    return "&lt;" if $_ == 60;
    return chr $_;
}

sub entity_encode_int_even_high_bit
{
    if ($_ > 127 || $_ == 34 || $_ == 38 || $_ == 39 || $_ == 60) 
    {
        # the ($_ > 127) should probably be removed
	return "&#" . $_ . ";"; 
    } 
    else 
    {
	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: $!";

    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 = "";
    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;
		}
	    }
	}
	
	$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
#   doesn't support nesting of translatable tags (i.e. <_blah>this <_doh>doesn't</_doh> work</_blah> -- besides
#   can you define the correct semantics for this?)
#

sub getXMLstring
{
    my $ref = shift;
    my @list = @{ $ref };
    my $result = "";

    my $count = scalar(@list);
    my $attrs = $list[0];
    my $index = 1;
    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;
		$result .= ($content);
	    } else {
		#print "no cdata content when expected it\n"; # is this possible, is this ok?
		# what to do if this happens?
		# Did I mention that I hate XML::Parser tree style?
	    }
	} else {
	    # We've got another element
	    $result .= "<$type";
	    $result .= getAttributeString($attrs, 0); # no nested translatable elements
	    if ($content) {
		my $subresult = getXMLstring($content);
		if ($subresult) {
		    $result .= ">".$subresult . "</$type>";
		} else {
		    $result .= "/>";
		}
	    } else {
		$result .= "/>";
	    }
	}
	$index += 2;
    }
    return $result;
}

sub traverse
{
    my $fh = shift; 
    my $nodename = shift;
    my $content = shift;
    my $language = shift || "";

    if (!$nodename) {
	if ($content =~ /^[\s]*$/) {
	    $leading_space .= $content;
	}
	print $fh $content;
    } else {
	# element
	my @all = @{ $content };
	my $attrs = shift @all;
	my $outattr = getAttributeString($attrs, 1, $language);
	my $translate = 0;

	if ($nodename =~ /^_/) {
	    $translate = 1;
	    $nodename =~ s/^_//;
	}
	my $lookup = '';
	print $fh "<$nodename$outattr";
	if ($translate) {
	    $lookup = getXMLstring($content);
	    $lookup =~ s/^\s+//s;
	    $lookup =~ s/\s+$//s;

	    if ($lookup) {
                my $translation = $translations{$language, $lookup};
                if ($MULTIPLE_OUTPUT && $translation) {
                    print $fh " xml:lang=\"", $language, "\"";
                    print $fh ">", $translation, "</$nodename>";
                    return; # this means there will be no same translation with xml:lang="$language"...
                            # if we want them both, just remove this "return"
                } else {
                    print $fh ">$lookup</$nodename>";
                }
	    } else {
		print $fh "/>";
	    }
	    
 
	    for my $lang (sort keys %po_files_by_lang) {
                    if ($MULTIPLE_OUTPUT && $lang ne "$language") {
                        next;
                    }
		    if ($lang) {

                        # Handle translation
                        #
			my $localattrs = getAttributeString($attrs, 1, $lang);
                        my $decode_string = ($lookup); #entity_decode($lookup);
                        my $translation = $translations{$lang, $decode_string};
                        if ($translation) {
                            $translation = ($translation);
			    print $fh "\n";
			    $leading_space =~ s/.*\n//g;
			    print $fh $leading_space;
 			    print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs;
			    print $fh ">", $translation , "</$nodename>";
			}
                    }
	    }

	} else {
	    my $count = scalar(@all);
	    if ($count > 0) {
		print $fh ">";
	    } else {
		print $fh "/>";
	    }
	    my $index = 0;
	    while ($index < $count) {
		my $type = $all[$index];
		my $rest = $all[$index+1];
		traverse($fh, $type, $rest, $language);
		$index += 2;
	    }
	    if ($count > 0) {
		print $fh "</$nodename>";
	    }
	}
    }
}

sub intltool_tree_char
{
    my $expat = shift;
    my $text  = shift;
    my $clist = $expat->{Curlist};
    my $pos   = $#$clist;

    # Use original_string so that we retain escaped entities
    # in CDATA sections.
    #
    if ($pos > 0 and $clist->[$pos - 1] eq '0') {
        $clist->[$pos] .= $expat->original_string();
    } else {
        push @$clist, 0 => $expat->original_string();
    }
}

sub intltool_tree_start
{
    my $expat    = shift;
    my $tag      = shift;
    my @origlist = ();

    # Use original_string so that we retain escaped entities
    # in attribute values.  We must convert the string to an
    # @origlist array to conform to the structure of the Tree
    # Style.
    #
    my @original_array = split /\x/, $expat->original_string();
    my $source         = $expat->original_string();

    # Remove leading tag.
    #
    $source =~ s|^\s*<\s*(\S+)||s;

    # Grab attribute key/value pairs and push onto @origlist array.
    #
    while ($source)
    {
       if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/)
       {
           $source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s;
           push @origlist, $1;
           push @origlist, '"' . $2 . '"';
       }
       elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/)
       {
           $source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s;
           push @origlist, $1;
           push @origlist, "'" . $2 . "'";
       }
       else
       {
           last;
       }
    }