← Back to branch summary

~ubuntu-branches/ubuntu/utopic/rhythmbox/utopic-proposed

« back to all changes in this revision

Viewing changes to intltool-merge.in

Tags: upstream-0.9.2
Import upstream version 0.9.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
intltool-merge.in
35
35
## Release information
36
36
my $PROGRAM = "intltool-merge";
37
37
my $PACKAGE = "intltool";
38
 
my $VERSION = "0.31.2";
 
38
my $VERSION = "0.34.1";
39
39
 
40
40
## Loaded modules
41
41
use strict; 
91
91
 
92
92
my %po_files_by_lang = ();
93
93
my %translations = ();
94
 
my $iconv = $ENV{"INTLTOOL_ICONV"} || "iconv";
 
94
my $iconv = $ENV{"ICONV"} || $ENV{"INTLTOOL_ICONV"} || "/usr/bin/iconv";
 
95
my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null');
95
96
 
96
97
# Use this instead of \w for XML files to handle more possible characters.
97
98
my $w = "[-A-Za-z0-9._:]";
111
112
} 
112
113
elsif ($BA_STYLE_ARG && @ARGV > 2) 
113
114
{
 
115
        &utf8_sanity_check;
114
116
        &preparation;
115
117
        &print_message;
116
118
        &ba_merge_translations;
118
120
} 
119
121
elsif ($XML_STYLE_ARG && @ARGV > 2) 
120
122
{
121
 
        &utf8_sanity_check;
 
123
        &utf8_sanity_check;
122
124
        &preparation;
123
125
        &print_message;
124
 
        
125
 
    &xml_merge_output;
126
 
 
 
126
        &xml_merge_output;
127
127
        &finalize;
128
128
} 
129
129
elsif ($KEYS_STYLE_ARG && @ARGV > 2) 
130
130
{
131
 
        &utf8_sanity_check;
132
 
        &preparation;
133
 
        &print_message;
134
 
        &keys_merge_translations;
 
131
        &utf8_sanity_check;
 
132
        &preparation;
 
133
        &print_message;
 
134
        &keys_merge_translations;
135
135
        &finalize;
136
136
} 
137
137
elsif ($DESKTOP_STYLE_ARG && @ARGV > 2) 
138
138
{
139
 
        &preparation;
140
 
        &print_message;
141
 
        &desktop_merge_translations;
 
139
        &utf8_sanity_check;
 
140
        &preparation;
 
141
        &print_message;
 
142
        &desktop_merge_translations;
142
143
        &finalize;
143
144
} 
144
145
elsif ($SCHEMAS_STYLE_ARG && @ARGV > 2) 
145
146
{
146
 
        &preparation;
147
 
        &print_message;
148
 
        &schemas_merge_translations;
 
147
        &utf8_sanity_check;
 
148
        &preparation;
 
149
        &print_message;
 
150
        &schemas_merge_translations;
149
151
        &finalize;
150
152
} 
151
153
elsif ($RFC822DEB_STYLE_ARG && @ARGV > 2) 
152
154
{
153
 
        &preparation;
154
 
        &print_message;
155
 
        &rfc822deb_merge_translations;
 
155
        &preparation;
 
156
        &print_message;
 
157
        &rfc822deb_merge_translations;
156
158
        &finalize;
157
159
} 
158
160
else 
194
196
  -x, --xml-style        includes translations in the standard xml style
195
197
 
196
198
Other options:
197
 
  -u, --utf8             convert all strings to UTF-8 before merging
198
 
  -p, --pass-through     use strings as found in .po files, without
199
 
                         conversion (STRONGLY unrecommended with -x)
 
199
  -u, --utf8             convert all strings to UTF-8 before merging 
 
200
                         (default for everything except RFC822 style)
 
201
  -p, --pass-through     deprecated, does nothing and issues a warning
200
202
  -m, --multiple-output  output one localized file per locale, instead of 
201
203
                         a single file containing all localized elements
202
204
  -c, --cache=FILE       specify cache file name
298
300
        $encoding = "ISO-8859-1";
299
301
    }
300
302
 
301
 
    system ("$iconv -f $encoding -t UTF-8 </dev/null 2>/dev/null");
 
303
    system ("$iconv -f $encoding -t UTF-8 <$devnull 2>$devnull");
302
304
    if ($?) {
303
305
        $encoding = get_local_charset($encoding);
304
306
    }
308
310
 
309
311
sub utf8_sanity_check 
310
312
{
311
 
    if (!$UTF8_ARG) 
312
 
    {
313
 
        if (!$PASS_THROUGH_ARG) 
314
 
        {
315
 
            $PASS_THROUGH_ARG="1";
316
 
        }
317
 
    }
 
313
    print STDERR "Warning: option --pass-through has been removed.\n" if $PASS_THROUGH_ARG;
 
314
    $UTF8_ARG = 1;
318
315
}
319
316
 
320
317
sub get_translation_database
462
459
    return "\\" if $sequence eq "\\\\";
463
460
    return "\"" if $sequence eq "\\\"";
464
461
    return "\n" if $sequence eq "\\n";
465
 
 
466
 
    # gettext also handles \n, \t, \b, \r, \f, \v, \a, \xxx (octal),
467
 
    # \xXX (hex) and has a comment saying they want to handle \u and \U.
 
462
    return "\r" if $sequence eq "\\r";
 
463
    return "\t" if $sequence eq "\\t";
 
464
    return "\b" if $sequence eq "\\b";
 
465
    return "\f" if $sequence eq "\\f";
 
466
    return "\a" if $sequence eq "\\a";
 
467
    return chr(11) if $sequence eq "\\v"; # vertical tab, see ascii(7)
 
468
 
 
469
    return chr(hex($1)) if ($sequence =~ /\\x([0-9a-fA-F]{2})/);
 
470
    return chr(oct($1)) if ($sequence =~ /\\([0-7]{3})/);
 
471
 
 
472
    # FIXME: Is \0 supported as well? Kenneth and Rodney don't want it, see bug #48489
468
473
 
469
474
    return $sequence;
470
475
}
473
478
{
474
479
    my ($string) = @_;
475
480
 
476
 
    $string =~ s/(\\.)/unescape_one_sequence($1)/eg;
 
481
    $string =~ s/(\\x[0-9a-fA-F]{2}|\\[0-7]{3}|\\.)/unescape_one_sequence($1)/eg;
477
482
 
478
483
    return $string;
479
484
}
494
499
 
495
500
# entity_encode: (string)
496
501
#
497
 
# Encode the given string to XML format (encode '<' etc). It also 
498
 
# encodes high bit if not in UTF-8 mode.
 
502
# Encode the given string to XML format (encode '<' etc).
499
503
 
500
504
sub entity_encode
501
505
{
503
507
 
504
508
    my @list_of_chars = unpack ('C*', $pre_encoded);
505
509
 
506
 
    if ($PASS_THROUGH_ARG) 
507
 
    {
508
 
        return join ('', map (&entity_encode_int_even_high_bit, @list_of_chars));
509
 
    } 
510
 
    else 
511
 
    {
512
 
        # with UTF-8 we only encode minimalistic
513
 
        return join ('', map (&entity_encode_int_minimalist, @list_of_chars));
514
 
    }
 
510
    # with UTF-8 we only encode minimalistic
 
511
    return join ('', map (&entity_encode_int_minimalist, @list_of_chars));
515
512
}
516
513
 
517
514
sub entity_encode_int_minimalist
523
520
    return chr $_;
524
521
}
525
522
 
526
 
sub entity_encode_int_even_high_bit
527
 
{
528
 
    if ($_ > 127 || $_ == 34 || $_ == 38 || $_ == 39 || $_ == 60) 
529
 
    {
530
 
        # the ($_ > 127) should probably be removed
531
 
        return "&#" . $_ . ";"; 
532
 
    } 
533
 
    else 
534
 
    {
535
 
        return chr $_;
536
 
    }
537
 
}
538
 
 
539
523
sub entity_encoded_translation
540
524
{
541
525
    my ($lang, $string) = @_;
559
543
    }
560
544
 
561
545
    open OUTPUT, ">$OUTFILE" or die "can't open $OUTFILE: $!";
 
546
    # Binmode so that selftest works ok if using a native Win32 Perl...
 
547
    binmode (OUTPUT) if $^O eq 'MSWin32';
562
548
 
563
549
    while ($source =~ s|^(.*?)([ \t]*<\s*$w+\s+($w+\s*=\s*"$q"\s*)+/?>)([ \t]*\n)?||s) 
564
550
    {
608
594
    my $do_translate = shift || 0;
609
595
    my $language = shift || "";
610
596
    my $result = "";
 
597
    my $translate = shift;
611
598
    foreach my $e (reverse(sort(keys %{ $sub }))) {
612
599
        my $key    = $e;
613
600
        my $string = $sub->{$e};
626
613
        if ($do_translate && $key =~ /^_/) {
627
614
            $key =~ s|^_||g;
628
615
            if ($language) {
629
 
                
630
616
                # Handle translation
631
 
                #
632
617
                my $decode_string = entity_decode($string);
633
618
                my $translation = $translations{$language, $decode_string};
634
619
                if ($translation) {
635
620
                    $translation = entity_encode($translation);
636
621
                    $string = $translation;
637
 
                }
638
 
            }
 
622
                }
 
623
                $$translate = 2;
 
624
            } else {
 
625
                 $$translate = 2 if ($translate && (!$$translate)); # watch not to "overwrite" $translate
 
626
            }
639
627
        }
640
628
        
641
629
        $result .= " $key=$quote$string$quote";
644
632
}
645
633
 
646
634
# Returns a translatable string from XML node, it works on contents of every node in XML::Parser tree
647
 
#   doesn't support nesting of translatable tags (i.e. <_blah>this <_doh>doesn't</_doh> work</_blah> -- besides
648
 
#   can you define the correct semantics for this?)
649
 
#
650
 
 
651
635
sub getXMLstring
652
636
{
653
637
    my $ref = shift;
 
638
    my $spacepreserve = shift || 0;
654
639
    my @list = @{ $ref };
655
640
    my $result = "";
656
641
 
657
642
    my $count = scalar(@list);
658
643
    my $attrs = $list[0];
659
644
    my $index = 1;
 
645
 
 
646
    $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
 
647
    $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
 
648
 
660
649
    while ($index < $count) {
661
650
        my $type = $list[$index];
662
651
        my $content = $list[$index+1];
664
653
            # We've got CDATA
665
654
            if ($content) {
666
655
                # lets strip the whitespace here, and *ONLY* here
667
 
                $content =~ s/\s+/ /gs;
668
 
                $result .= ($content);
669
 
            } else {
670
 
                #print "no cdata content when expected it\n"; # is this possible, is this ok?
671
 
                # what to do if this happens?
672
 
                # Did I mention that I hate XML::Parser tree style?
 
656
                $content =~ s/\s+/ /gs if (!$spacepreserve);
 
657
                $result .= $content;
673
658
            }
674
 
        } else {
 
659
        } elsif ( "$type" ne "1" ) {
675
660
            # We've got another element
676
661
            $result .= "<$type";
677
 
            $result .= getAttributeString($attrs, 0); # no nested translatable elements
 
662
            $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements
678
663
            if ($content) {
679
 
                my $subresult = getXMLstring($content);
 
664
                my $subresult = getXMLstring($content, $spacepreserve);
680
665
                if ($subresult) {
681
666
                    $result .= ">".$subresult . "</$type>";
682
667
                } else {
691
676
    return $result;
692
677
}
693
678
 
 
679
# Translate list of nodes if necessary
 
680
sub translate_subnodes
 
681
{
 
682
    my $fh = shift;
 
683
    my $content = shift;
 
684
    my $language = shift || "";
 
685
    my $singlelang = shift || 0;
 
686
    my $spacepreserve = shift || 0;
 
687
 
 
688
    my @nodes = @{ $content };
 
689
 
 
690
    my $count = scalar(@nodes);
 
691
    my $index = 0;
 
692
    while ($index < $count) {
 
693
        my $type = $nodes[$index];
 
694
        my $rest = $nodes[$index+1];
 
695
        if ($singlelang) {
 
696
            my $oldMO = $MULTIPLE_OUTPUT;
 
697
            $MULTIPLE_OUTPUT = 1;
 
698
            traverse($fh, $type, $rest, $language, $spacepreserve);
 
699
            $MULTIPLE_OUTPUT = $oldMO;
 
700
        } else {
 
701
            traverse($fh, $type, $rest, $language, $spacepreserve);
 
702
        }
 
703
        $index += 2;
 
704
    }
 
705
}
 
706
 
 
707
sub isWellFormedXmlFragment
 
708
{
 
709
    my $ret = eval 'require XML::Parser';
 
710
    if(!$ret) {
 
711
        die "You must have XML::Parser installed to run $0\n\n";
 
712
    } 
 
713
 
 
714
    my $fragment = shift;
 
715
    return 0 if (!$fragment);
 
716
 
 
717
    $fragment = "<root>$fragment</root>";
 
718
    my $xp = new XML::Parser(Style => 'Tree');
 
719
    my $tree = 0;
 
720
    eval { $tree = $xp->parse($fragment); };
 
721
    return $tree;
 
722
}
 
723
 
694
724
sub traverse
695
725
{
696
726
    my $fh = shift; 
697
727
    my $nodename = shift;
698
728
    my $content = shift;
699
729
    my $language = shift || "";
 
730
    my $spacepreserve = shift || 0;
700
731
 
701
732
    if (!$nodename) {
702
733
        if ($content =~ /^[\s]*$/) {
707
738
        # element
708
739
        my @all = @{ $content };
709
740
        my $attrs = shift @all;
710
 
        my $outattr = getAttributeString($attrs, 1, $language);
711
741
        my $translate = 0;
 
742
        my $outattr = getAttributeString($attrs, 1, $language, \$translate);
712
743
 
713
744
        if ($nodename =~ /^_/) {
714
745
            $translate = 1;
715
746
            $nodename =~ s/^_//;
716
747
        }
717
748
        my $lookup = '';
718
 
        print $fh "<$nodename$outattr";
 
749
 
 
750
        $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
 
751
        $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
 
752
 
 
753
        print $fh "<$nodename", $outattr;
719
754
        if ($translate) {
720
 
            $lookup = getXMLstring($content);
721
 
            $lookup =~ s/^\s+//s;
722
 
            $lookup =~ s/\s+$//s;
723
 
 
724
 
            if ($lookup) {
725
 
                my $translation = $translations{$language, $lookup};
726
 
                if ($MULTIPLE_OUTPUT && $translation) {
727
 
                    print $fh " xml:lang=\"", $language, "\"";
728
 
                    print $fh ">", $translation, "</$nodename>";
 
755
            $lookup = getXMLstring($content, $spacepreserve);
 
756
            if (!$spacepreserve) {
 
757
                $lookup =~ s/^\s+//s;
 
758
                $lookup =~ s/\s+$//s;
 
759
            }
 
760
 
 
761
            if ($lookup || $translate == 2) {
 
762
                my $translation = $translations{$language, $lookup} if isWellFormedXmlFragment($translations{$language, $lookup});
 
763
                if ($MULTIPLE_OUTPUT && ($translation || $translate == 2)) {
 
764
                    $translation = $lookup if (!$translation);
 
765
                    print $fh " xml:lang=\"", $language, "\"" if $language;
 
766
                    print $fh ">";
 
767
                    if ($translate == 2) {
 
768
                        translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
 
769
                    } else {
 
770
                        print $fh $translation;
 
771
                    }
 
772
                    print $fh "</$nodename>";
 
773
 
729
774
                    return; # this means there will be no same translation with xml:lang="$language"...
730
775
                            # if we want them both, just remove this "return"
731
776
                } else {
732
 
                    print $fh ">$lookup</$nodename>";
 
777
                    print $fh ">";
 
778
                    if ($translate == 2) {
 
779
                        translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
 
780
                    } else {
 
781
                        print $fh $lookup;
 
782
                    }
 
783
                    print $fh "</$nodename>";
733
784
                }
734
785
            } else {
735
786
                print $fh "/>";
736
787
            }
737
 
            
738
 
 
 
788
 
739
789
            for my $lang (sort keys %po_files_by_lang) {
740
790
                    if ($MULTIPLE_OUTPUT && $lang ne "$language") {
741
791
                        next;
742
792
                    }
743
793
                    if ($lang) {
744
 
 
745
794
                        # Handle translation
746
795
                        #
747
 
                        my $localattrs = getAttributeString($attrs, 1, $lang);
748
 
                        my $decode_string = ($lookup); #entity_decode($lookup);
749
 
                        my $translation = $translations{$lang, $decode_string};
750
 
                        if ($translation) {
751
 
                            $translation = ($translation);
 
796
                        my $translate = 0;
 
797
                        my $localattrs = getAttributeString($attrs, 1, $lang, \$translate);
 
798
                        my $translation = $translations{$lang, $lookup} if isWellFormedXmlFragment($translations{$lang, $lookup});
 
799
                        if ($translate && !$translation) {
 
800
                            $translation = $lookup;
 
801
                        }
 
802
 
 
803
                        if ($translation || $translate) {
752
804
                            print $fh "\n";
753
805
                            $leading_space =~ s/.*\n//g;
754
806
                            print $fh $leading_space;
755
 
                            print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs;
756
 
                            print $fh ">", $translation , "</$nodename>";
 
807
                            print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs, ">";
 
808
                            if ($translate == 2) {
 
809
                               translate_subnodes($fh, \@all, $lang, 1, $spacepreserve);
 
810
                            } else {
 
811
                                print $fh $translation;
 
812
                            }
 
813
                            print $fh "</$nodename>";
757
814
                        }
758
815
                    }
759
816
            }
762
819
            my $count = scalar(@all);
763
820
            if ($count > 0) {
764
821
                print $fh ">";
765
 
            } else {
766
 
                print $fh "/>";
767
 
            }
768
 
            my $index = 0;
769
 
            while ($index < $count) {
770
 
                my $type = $all[$index];
771
 
                my $rest = $all[$index+1];
772
 
                traverse($fh, $type, $rest, $language);
773
 
                $index += 2;
774
 
            }
775
 
            if ($count > 0) {
 
822
                my $index = 0;
 
823
                while ($index < $count) {
 
824
                    my $type = $all[$index];
 
825
                    my $rest = $all[$index+1];
 
826
                    traverse($fh, $type, $rest, $language, $spacepreserve);
 
827
                    $index += 2;
 
828
                }
776
829
                print $fh "</$nodename>";
 
830
            } else {
 
831
                print $fh "/>";
777
832
            }
778
833
        }
779
834
    }
780
835
}
781
836
 
 
837
sub intltool_tree_comment
 
838
{
 
839
    my $expat = shift;
 
840
    my $data  = shift;
 
841
    my $clist = $expat->{Curlist};
 
842
    my $pos   = $#$clist;
 
843
 
 
844
    push @$clist, 1 => $data;
 
845
}
 
846
 
 
847
sub intltool_tree_cdatastart
 
848
{
 
849
    my $expat    = shift;
 
850
    my $clist = $expat->{Curlist};
 
851
    my $pos   = $#$clist;
 
852
 
 
853
    push @$clist, 0 => $expat->original_string();
 
854
}
 
855
 
 
856
sub intltool_tree_cdataend
 
857
{
 
858
    my $expat    = shift;
 
859
    my $clist = $expat->{Curlist};
 
860
    my $pos   = $#$clist;
 
861
 
 
862
    $clist->[$pos] .= $expat->original_string();
 
863
}
 
864
 
782
865
sub intltool_tree_char
783
866
{
784
867
    my $expat = shift;
857
940
    my $xp = new XML::Parser(Style => 'Tree');
858
941
    $xp->setHandlers(Char => \&intltool_tree_char);
859
942
    $xp->setHandlers(Start => \&intltool_tree_start);
 
943
    $xp->setHandlers(CdataStart => \&intltool_tree_cdatastart);
 
944
    $xp->setHandlers(CdataEnd => \&intltool_tree_cdataend);
860
945
    my $tree = $xp->parsefile($filename);
861
946
 
862
947
# <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
902
987
 
903
988
    my $name = shift @{ $ref };
904
989
    my $cont = shift @{ $ref };
905
 
    traverse($fh, $name, $cont, $language);
 
990
    
 
991
    while (!$name || "$name" eq "1") {
 
992
        $name = shift @{ $ref };
 
993
        $cont = shift @{ $ref };
 
994
    }
 
995
 
 
996
    my $spacepreserve = 0;
 
997
    my $attrs = @{$cont}[0];
 
998
    $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
 
999
 
 
1000
    traverse($fh, $name, $cont, $language, $spacepreserve);
906
1001
}
907
1002
 
908
1003
sub xml_merge_output
915
1010
                mkdir $lang or die "Cannot create subdirectory $lang: $!\n";
916
1011
            }
917
1012
            open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
 
1013
            binmode (OUTPUT) if $^O eq 'MSWin32';
918
1014
            my $tree = readXml($FILE);
919
1015
            print_header($FILE, \*OUTPUT);
920
1016
            parseTree(\*OUTPUT, $tree, $lang);
923
1019
        }
924
1020
    } 
925
1021
    open OUTPUT, ">$OUTFILE" or die "Cannot open $OUTFILE: $!\n";
 
1022
    binmode (OUTPUT) if $^O eq 'MSWin32';
926
1023
    my $tree = readXml($FILE);
927
1024
    print_header($FILE, \*OUTPUT);
928
1025
    parseTree(\*OUTPUT, $tree);
934
1031
{
935
1032
    open INPUT, "<${FILE}" or die;
936
1033
    open OUTPUT, ">${OUTFILE}" or die;
 
1034
    binmode (OUTPUT) if $^O eq 'MSWin32';
937
1035
 
938
1036
    while (<INPUT>) 
939
1037
    {
969
1067
{
970
1068
    open INPUT, "<${FILE}" or die;
971
1069
    open OUTPUT, ">${OUTFILE}" or die;
 
1070
    binmode (OUTPUT) if $^O eq 'MSWin32';
972
1071
 
973
1072
    while (<INPUT>) 
974
1073
    {
1012
1111
    }
1013
1112
 
1014
1113
    open OUTPUT, ">$OUTFILE" or die;
 
1114
    binmode (OUTPUT) if $^O eq 'MSWin32';
1015
1115
 
1016
1116
    # FIXME: support attribute translations
1017
1117
 
1113
1213
    }
1114
1214
 
1115
1215
    open OUTPUT, ">${OUTFILE}" or die;
 
1216
    binmode (OUTPUT) if $^O eq 'MSWin32';
1116
1217
 
1117
1218
    while ($source =~ /(^|\n+)(_*)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg)
1118
1219
    {