60
60
my $DESKTOP_STYLE_ARG = 0;
61
61
my $SCHEMAS_STYLE_ARG = 0;
62
62
my $RFC822DEB_STYLE_ARG = 0;
63
my $QUOTED_STYLE_ARG = 0;
64
65
my $PASS_THROUGH_ARG = 0;
79
80
"desktop-style|d" => \$DESKTOP_STYLE_ARG,
80
81
"schemas-style|s" => \$SCHEMAS_STYLE_ARG,
81
82
"rfc822deb-style|r" => \$RFC822DEB_STYLE_ARG,
83
"quoted-style" => \$QUOTED_STYLE_ARG,
82
84
"pass-through|p" => \$PASS_THROUGH_ARG,
83
85
"utf8|u" => \$UTF8_ARG,
84
86
"multiple-output|m" => \$MULTIPLE_OUTPUT,
92
94
my %po_files_by_lang = ();
93
95
my %translations = ();
94
96
my $iconv = $ENV{"ICONV"} || $ENV{"INTLTOOL_ICONV"} || "@INTLTOOL_ICONV@";
97
my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null');
96
99
# Use this instead of \w for XML files to handle more possible characters.
97
100
my $w = "[-A-Za-z0-9._:]";
192
203
-k, --keys-style includes translations in the keys style
193
204
-s, --schemas-style includes translations in the schemas style
194
205
-r, --rfc822deb-style includes translations in the RFC822 style
206
--quoted-style includes translations in the quoted string style
195
207
-x, --xml-style includes translations in the standard xml style
397
print STDERR "WARNING: $po_file is not in UTF-8 but $encoding, converting...\n" unless $QUIET_ARG;;
409
print "NOTICE: $po_file is not in UTF-8 but $encoding, converting...\n" unless $QUIET_ARG;;
399
411
open PO_FILE, "$iconv -f $encoding -t UTF-8 $po_file|";
544
556
open OUTPUT, ">$OUTFILE" or die "can't open $OUTFILE: $!";
557
# Binmode so that selftest works ok if using a native Win32 Perl...
558
binmode (OUTPUT) if $^O eq 'MSWin32';
546
560
while ($source =~ s|^(.*?)([ \t]*<\s*$w+\s+($w+\s*=\s*"$q"\s*)+/?>)([ \t]*\n)?||s)
610
624
if ($do_translate && $key =~ /^_/) {
614
627
# Handle translation
616
628
my $decode_string = entity_decode($string);
617
629
my $translation = $translations{$language, $decode_string};
618
630
if ($translation) {
619
631
$translation = entity_encode($translation);
620
632
$string = $translation;
624
$$translate = 1 if ($translate && (!$$translate)); # watch not to "overwrite" if $translate == 2
636
$$translate = 2 if ($translate && (!$$translate)); # watch not to "overwrite" $translate
633
645
# Returns a translatable string from XML node, it works on contents of every node in XML::Parser tree
634
# doesn't support nesting of translatable tags (i.e. <_blah>this <_doh>doesn't</_doh> work</_blah> -- besides
635
# can you define the correct semantics for this?)
649
my $spacepreserve = shift || 0;
641
650
my @list = @{ $ref };
645
654
my $attrs = $list[0];
657
$spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
658
$spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
648
660
while ($index < $count) {
649
661
my $type = $list[$index];
650
662
my $content = $list[$index+1];
652
664
# We've got CDATA
654
666
# lets strip the whitespace here, and *ONLY* here
655
$content =~ s/\s+/ /gs if (!((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)));
656
$result .= ($content);
658
#print "no cdata content when expected it\n"; # is this possible, is this ok?
659
# what to do if this happens?
660
# Did I mention that I hate XML::Parser tree style?
667
$content =~ s/\s+/ /gs if (!$spacepreserve);
670
} elsif ( "$type" ne "1" ) {
663
671
# We've got another element
664
672
$result .= "<$type";
665
673
$result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements
667
my $subresult = getXMLstring($content);
675
my $subresult = getXMLstring($content, $spacepreserve);
668
676
if ($subresult) {
669
677
$result .= ">".$subresult . "</$type>";
690
# Translate list of nodes if necessary
691
sub translate_subnodes
695
my $language = shift || "";
696
my $singlelang = shift || 0;
697
my $spacepreserve = shift || 0;
699
my @nodes = @{ $content };
701
my $count = scalar(@nodes);
703
while ($index < $count) {
704
my $type = $nodes[$index];
705
my $rest = $nodes[$index+1];
707
my $oldMO = $MULTIPLE_OUTPUT;
708
$MULTIPLE_OUTPUT = 1;
709
traverse($fh, $type, $rest, $language, $spacepreserve);
710
$MULTIPLE_OUTPUT = $oldMO;
712
traverse($fh, $type, $rest, $language, $spacepreserve);
718
sub isWellFormedXmlFragment
720
my $ret = eval 'require XML::Parser';
722
die "You must have XML::Parser installed to run $0\n\n";
725
my $fragment = shift;
726
return 0 if (!$fragment);
728
$fragment = "<root>$fragment</root>";
729
my $xp = new XML::Parser(Style => 'Tree');
731
eval { $tree = $xp->parse($fragment); };
685
738
my $nodename = shift;
686
739
my $content = shift;
687
740
my $language = shift || "";
741
my $spacepreserve = shift || 0;
689
743
if (!$nodename) {
690
744
if ($content =~ /^[\s]*$/) {
703
757
$nodename =~ s/^_//;
761
$spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
762
$spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
706
764
print $fh "<$nodename", $outattr;
707
765
if ($translate) {
708
$lookup = getXMLstring($content);
709
if (!((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/))) {
766
$lookup = getXMLstring($content, $spacepreserve);
767
if (!$spacepreserve) {
710
768
$lookup =~ s/^\s+//s;
711
769
$lookup =~ s/\s+$//s;
714
772
if ($lookup || $translate == 2) {
715
my $translation = $translations{$language, $lookup};
773
my $translation = $translations{$language, $lookup} if isWellFormedXmlFragment($translations{$language, $lookup});
716
774
if ($MULTIPLE_OUTPUT && ($translation || $translate == 2)) {
717
775
$translation = $lookup if (!$translation);
718
print $fh " xml:lang=\"", $language, "\"";
719
print $fh ">", $translation, "</$nodename>";
776
print $fh " xml:lang=\"", $language, "\"" if $language;
778
if ($translate == 2) {
779
translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
781
print $fh $translation;
783
print $fh "</$nodename>";
720
785
return; # this means there will be no same translation with xml:lang="$language"...
721
786
# if we want them both, just remove this "return"
723
print $fh ">$lookup</$nodename>";
789
if ($translate == 2) {
790
translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
794
print $fh "</$nodename>";
736
807
my $translate = 0;
737
808
my $localattrs = getAttributeString($attrs, 1, $lang, \$translate);
738
my $translation = $translations{$lang, $lookup};
809
my $translation = $translations{$lang, $lookup} if isWellFormedXmlFragment($translations{$lang, $lookup});
739
810
if ($translate && !$translation) {
740
811
$translation = $lookup;
743
814
if ($translation || $translate) {
744
$translation = ($translation);
746
816
$leading_space =~ s/.*\n//g;
747
817
print $fh $leading_space;
748
print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs;
749
print $fh ">", $translation , "</$nodename>";
818
print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs, ">";
819
if ($translate == 2) {
820
translate_subnodes($fh, \@all, $lang, 1, $spacepreserve);
822
print $fh $translation;
824
print $fh "</$nodename>";
755
830
my $count = scalar(@all);
756
831
if ($count > 0) {
762
while ($index < $count) {
763
my $type = $all[$index];
764
my $rest = $all[$index+1];
765
traverse($fh, $type, $rest, $language);
834
while ($index < $count) {
835
my $type = $all[$index];
836
my $rest = $all[$index+1];
837
traverse($fh, $type, $rest, $language, $spacepreserve);
769
840
print $fh "</$nodename>";
848
sub intltool_tree_comment
852
my $clist = $expat->{Curlist};
855
push @$clist, 1 => $data;
858
sub intltool_tree_cdatastart
861
my $clist = $expat->{Curlist};
864
push @$clist, 0 => $expat->original_string();
867
sub intltool_tree_cdataend
870
my $clist = $expat->{Curlist};
873
$clist->[$pos] .= $expat->original_string();
775
876
sub intltool_tree_char
777
878
my $expat = shift;
850
951
my $xp = new XML::Parser(Style => 'Tree');
851
952
$xp->setHandlers(Char => \&intltool_tree_char);
852
953
$xp->setHandlers(Start => \&intltool_tree_start);
954
$xp->setHandlers(CdataStart => \&intltool_tree_cdatastart);
955
$xp->setHandlers(CdataEnd => \&intltool_tree_cdataend);
853
956
my $tree = $xp->parsefile($filename);
855
958
# <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
896
999
my $name = shift @{ $ref };
897
1000
my $cont = shift @{ $ref };
898
traverse($fh, $name, $cont, $language);
1002
while (!$name || "$name" eq "1") {
1003
$name = shift @{ $ref };
1004
$cont = shift @{ $ref };
1007
my $spacepreserve = 0;
1008
my $attrs = @{$cont}[0];
1009
$spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
1011
traverse($fh, $name, $cont, $language, $spacepreserve);
901
1014
sub xml_merge_output
908
1021
mkdir $lang or die "Cannot create subdirectory $lang: $!\n";
910
1023
open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
1024
binmode (OUTPUT) if $^O eq 'MSWin32';
911
1025
my $tree = readXml($FILE);
912
1026
print_header($FILE, \*OUTPUT);
913
1027
parseTree(\*OUTPUT, $tree, $lang);
918
1032
open OUTPUT, ">$OUTFILE" or die "Cannot open $OUTFILE: $!\n";
1033
binmode (OUTPUT) if $^O eq 'MSWin32';
919
1034
my $tree = readXml($FILE);
920
1035
print_header($FILE, \*OUTPUT);
921
1036
parseTree(\*OUTPUT, $tree);
1368
sub quoted_translation
1370
my ($lang, $string) = @_;
1372
$string =~ s/\\\"/\"/g;
1374
my $translation = $translations{$lang, $string};
1375
$translation = $string if !$translation;
1377
$translation =~ s/\"/\\\"/g;
1381
sub quoted_merge_translations
1383
if (!$MULTIPLE_OUTPUT) {
1384
print "Quoted only supports Multiple Output.\n";
1388
for my $lang (sort keys %po_files_by_lang) {
1390
mkdir $lang or die "Cannot create subdirectory $lang: $!\n";
1392
open INPUT, "<${FILE}" or die;
1393
open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
1394
binmode (OUTPUT) if $^O eq 'MSWin32';
1397
s/\"(([^\"]|\\\")*[^\\\"])\"/"\"" . "ed_translation($lang, $1) . "\""/ge;
added
removed
intltool-merge.in
