← Back to branch summary

~ubuntu-branches/ubuntu/maverick/uim/maverick

« back to all changes in this revision

Viewing changes to intltool-merge.in

  • Committer: Bazaar Package Importer
  • Author(s): Masahito Omote
  • Date: 2006-11-23 15:10:53 UTC
  • mfrom: (3.1.8 edgy)
  • Revision ID: james.westby@ubuntu.com-20061123151053-q42sk1lvks41xpfx
Tags: 1:1.2.1-9
http://bugs.debian.org/398530
uim-gtk2.0.postinst: Don't call update-gtk-immodules on purge.
(closes: Bug#398530)

Show diffs side-by-side

added added

removed removed

Lines of Context:
intltool-merge.in
1
1
#!@INTLTOOL_PERL@ -w
 
2
# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4  -*-
2
3
 
3
4
#
4
5
#  The Intltool Message Merger
34
35
## Release information
35
36
my $PROGRAM = "intltool-merge";
36
37
my $PACKAGE = "intltool";
37
 
my $VERSION = "0.27.2";
 
38
my $VERSION = "0.31.2";
38
39
 
39
40
## Loaded modules
40
41
use strict; 
41
42
use Getopt::Long;
42
43
use Text::Wrap;
 
44
use File::Basename;
 
45
 
 
46
my $must_end_tag      = -1;
 
47
my $last_depth        = -1;
 
48
my $translation_depth = -1;
 
49
my @tag_stack = ();
 
50
my @entered_tag = ();
 
51
my @translation_strings = ();
 
52
my $leading_space = "";
43
53
 
44
54
## Scalars used by the option stuff
45
55
my $HELP_ARG = 0;
53
63
my $QUIET_ARG = 0;
54
64
my $PASS_THROUGH_ARG = 0;
55
65
my $UTF8_ARG = 0;
 
66
my $MULTIPLE_OUTPUT = 0;
56
67
my $cache_file;
57
68
 
58
69
## Handle options
70
81
 "rfc822deb-style|r" => \$RFC822DEB_STYLE_ARG,
71
82
 "pass-through|p" => \$PASS_THROUGH_ARG,
72
83
 "utf8|u" => \$UTF8_ARG,
 
84
 "multiple-output|m" => \$MULTIPLE_OUTPUT,
73
85
 "cache|c=s" => \$cache_file
74
86
 ) or &error;
75
87
 
109
121
        &utf8_sanity_check;
110
122
        &preparation;
111
123
        &print_message;
112
 
        &xml_merge_translations;
 
124
        
 
125
    &xml_merge_output;
 
126
 
113
127
        &finalize;
114
128
} 
115
129
elsif ($KEYS_STYLE_ARG && @ARGV > 2) 
183
197
  -u, --utf8             convert all strings to UTF-8 before merging
184
198
  -p, --pass-through     use strings as found in .po files, without
185
199
                         conversion (STRONGLY unrecommended with -x)
 
200
  -m, --multiple-output  output one localized file per locale, instead of 
 
201
                         a single file containing all localized elements
186
202
  -c, --cache=FILE       specify cache file name
187
203
                         (usually \$top_builddir/po/.intltool-merge-cache)
188
204
  -q, --quiet            suppress most messages
583
599
 
584
600
## XML (non-bonobo-activation) merge code
585
601
 
586
 
sub xml_merge_translations
587
 
{
588
 
    my $source;
589
 
 
590
 
    {
591
 
       local $/; # slurp mode
592
 
       open INPUT, "<$FILE" or die "can't open $FILE: $!";
593
 
       $source = <INPUT>;
594
 
       close INPUT;
595
 
    }
596
 
 
597
 
    open OUTPUT, ">$OUTFILE" or die;
598
 
 
599
 
    # FIXME: support attribute translations
600
 
 
601
 
    # Empty nodes never need translation, so unmark all of them.
602
 
    # For example, <_foo/> is just replaced by <foo/>.
603
 
    $source =~ s|<\s*_($w+)\s*/>|<$1/>|g;
604
 
 
605
 
    # Support for <_foo>blah</_foo> style translations.
606
 
    while ($source =~ s|^(.*?)([ \t]*)<\s*_($w+)\s*>(.*?)<\s*/_\3\s*>([ \t]*\n)?||s) 
607
 
    {
608
 
        print OUTPUT $1;
609
 
 
610
 
        my $spaces = $2;
611
 
        my $tag = $3;
612
 
        my $string = $4;
613
 
 
614
 
        print OUTPUT "$spaces<$tag>$string</$tag>\n";
615
 
 
616
 
        $string =~ s/\s+/ /g;
617
 
        $string =~ s/^ //;
618
 
        $string =~ s/ $//;
619
 
        $string = entity_decode($string);
620
 
 
621
 
        for my $lang (sort keys %po_files_by_lang) 
622
 
        {
623
 
            my $translation = $translations{$lang, $string};
624
 
            next if !$translation;
625
 
            $translation = entity_encode($translation);
626
 
            print OUTPUT "$spaces<$tag xml:lang=\"$lang\">$translation</$tag>\n";
 
602
 
 
603
# Process tag attributes
 
604
#   Only parameter is a HASH containing attributes -> values mapping
 
605
sub getAttributeString
 
606
{
 
607
    my $sub = shift;
 
608
    my $do_translate = shift || 0;
 
609
    my $language = shift || "";
 
610
    my $result = "";
 
611
    foreach my $e (reverse(sort(keys %{ $sub }))) {
 
612
        my $key    = $e;
 
613
        my $string = $sub->{$e};
 
614
        my $quote = '"';
 
615
        
 
616
        $string =~ s/^[\s]+//;
 
617
        $string =~ s/[\s]+$//;
 
618
        
 
619
        if ($string =~ /^'.*'$/)
 
620
        {
 
621
            $quote = "'";
 
622
        }
 
623
        $string =~ s/^['"]//g;
 
624
        $string =~ s/['"]$//g;
 
625
 
 
626
        if ($do_translate && $key =~ /^_/) {
 
627
            $key =~ s|^_||g;
 
628
            if ($language) {
 
629
                
 
630
                # Handle translation
 
631
                #
 
632
                my $decode_string = entity_decode($string);
 
633
                my $translation = $translations{$language, $decode_string};
 
634
                if ($translation) {
 
635
                    $translation = entity_encode($translation);
 
636
                    $string = $translation;
 
637
                }
 
638
            }
 
639
        }
 
640
        
 
641
        $result .= " $key=$quote$string$quote";
 
642
    }
 
643
    return $result;
 
644
}
 
645
 
 
646
# 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
sub getXMLstring
 
652
{
 
653
    my $ref = shift;
 
654
    my @list = @{ $ref };
 
655
    my $result = "";
 
656
 
 
657
    my $count = scalar(@list);
 
658
    my $attrs = $list[0];
 
659
    my $index = 1;
 
660
    while ($index < $count) {
 
661
        my $type = $list[$index];
 
662
        my $content = $list[$index+1];
 
663
        if (! $type ) {
 
664
            # We've got CDATA
 
665
            if ($content) {
 
666
                # 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?
 
673
            }
 
674
        } else {
 
675
            # We've got another element
 
676
            $result .= "<$type";
 
677
            $result .= getAttributeString($attrs, 0); # no nested translatable elements
 
678
            if ($content) {
 
679
                my $subresult = getXMLstring($content);
 
680
                if ($subresult) {
 
681
                    $result .= ">".$subresult . "</$type>";
 
682
                } else {
 
683
                    $result .= "/>";
 
684
                }
 
685
            } else {
 
686
                $result .= "/>";
 
687
            }
 
688
        }
 
689
        $index += 2;
 
690
    }
 
691
    return $result;
 
692
}
 
693
 
 
694
sub traverse
 
695
{
 
696
    my $fh = shift; 
 
697
    my $nodename = shift;
 
698
    my $content = shift;
 
699
    my $language = shift || "";
 
700
 
 
701
    if (!$nodename) {
 
702
        if ($content =~ /^[\s]*$/) {
 
703
            $leading_space .= $content;
 
704
        }
 
705
        print $fh $content;
 
706
    } else {
 
707
        # element
 
708
        my @all = @{ $content };
 
709
        my $attrs = shift @all;
 
710
        my $outattr = getAttributeString($attrs, 1, $language);
 
711
        my $translate = 0;
 
712
 
 
713
        if ($nodename =~ /^_/) {
 
714
            $translate = 1;
 
715
            $nodename =~ s/^_//;
 
716
        }
 
717
        my $lookup = '';
 
718
        print $fh "<$nodename$outattr";
 
719
        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>";
 
729
                    return; # this means there will be no same translation with xml:lang="$language"...
 
730
                            # if we want them both, just remove this "return"
 
731
                } else {
 
732
                    print $fh ">$lookup</$nodename>";
 
733
                }
 
734
            } else {
 
735
                print $fh "/>";
 
736
            }
 
737
            
 
738
 
 
739
            for my $lang (sort keys %po_files_by_lang) {
 
740
                    if ($MULTIPLE_OUTPUT && $lang ne "$language") {
 
741
                        next;
 
742
                    }
 
743
                    if ($lang) {
 
744
 
 
745
                        # Handle translation
 
746
                        #
 
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);
 
752
                            print $fh "\n";
 
753
                            $leading_space =~ s/.*\n//g;
 
754
                            print $fh $leading_space;
 
755
                            print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs;
 
756
                            print $fh ">", $translation , "</$nodename>";
 
757
                        }
 
758
                    }
 
759
            }
 
760
 
 
761
        } else {
 
762
            my $count = scalar(@all);
 
763
            if ($count > 0) {
 
764
                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) {
 
776
                print $fh "</$nodename>";
 
777
            }
 
778
        }
 
779
    }
 
780
}
 
781
 
 
782
sub intltool_tree_char
 
783
{
 
784
    my $expat = shift;
 
785
    my $text  = shift;
 
786
    my $clist = $expat->{Curlist};
 
787
    my $pos   = $#$clist;
 
788
 
 
789
    # Use original_string so that we retain escaped entities
 
790
    # in CDATA sections.
 
791
    #
 
792
    if ($pos > 0 and $clist->[$pos - 1] eq '0') {
 
793
        $clist->[$pos] .= $expat->original_string();
 
794
    } else {
 
795
        push @$clist, 0 => $expat->original_string();
 
796
    }
 
797
}
 
798
 
 
799
sub intltool_tree_start
 
800
{
 
801
    my $expat    = shift;
 
802
    my $tag      = shift;
 
803
    my @origlist = ();
 
804
 
 
805
    # Use original_string so that we retain escaped entities
 
806
    # in attribute values.  We must convert the string to an
 
807
    # @origlist array to conform to the structure of the Tree
 
808
    # Style.
 
809
    #
 
810
    my @original_array = split /\x/, $expat->original_string();
 
811
    my $source         = $expat->original_string();
 
812
 
 
813
    # Remove leading tag.
 
814
    #
 
815
    $source =~ s|^\s*<\s*(\S+)||s;
 
816
 
 
817
    # Grab attribute key/value pairs and push onto @origlist array.
 
818
    #
 
819
    while ($source)
 
820
    {
 
821
       if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/)
 
822
       {
 
823
           $source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s;
 
824
           push @origlist, $1;
 
825
           push @origlist, '"' . $2 . '"';
 
826
       }
 
827
       elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/)
 
828
       {
 
829
           $source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s;
 
830
           push @origlist, $1;
 
831
           push @origlist, "'" . $2 . "'";
 
832
       }
 
833
       else
 
834
       {
 
835
           last;
 
836
       }
 
837
    }
 
838
 
 
839
    my $ol = [ { @origlist } ];
 
840
 
 
841
    push @{ $expat->{Lists} }, $expat->{Curlist};
 
842
    push @{ $expat->{Curlist} }, $tag => $ol;
 
843
    $expat->{Curlist} = $ol;
 
844
}
 
845
 
 
846
sub readXml
 
847
{
 
848
    my $filename = shift || return;
 
849
    if(!-f $filename) {
 
850
        die "ERROR Cannot find filename: $filename\n";
 
851
    }
 
852
 
 
853
    my $ret = eval 'require XML::Parser';
 
854
    if(!$ret) {
 
855
        die "You must have XML::Parser installed to run $0\n\n";
 
856
    } 
 
857
    my $xp = new XML::Parser(Style => 'Tree');
 
858
    $xp->setHandlers(Char => \&intltool_tree_char);
 
859
    $xp->setHandlers(Start => \&intltool_tree_start);
 
860
    my $tree = $xp->parsefile($filename);
 
861
 
 
862
# <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
 
863
# would be:
 
864
# [foo, [{}, head, [{id => "a"}, 0, "Hello ",  em, [{}, 0, "there"]], bar, [{},
 
865
# 0, "Howdy",  ref, [{}]], 0, "do" ] ]
 
866
 
 
867
    return $tree;
 
868
}
 
869
 
 
870
sub print_header
 
871
{
 
872
    my $infile = shift;
 
873
    my $fh = shift;
 
874
    my $source;
 
875
 
 
876
    if(!-f $infile) {
 
877
        die "ERROR Cannot find filename: $infile\n";
 
878
    }
 
879
 
 
880
    print $fh qq{<?xml version="1.0" encoding="UTF-8"?>\n};
 
881
    {
 
882
        local $/;
 
883
        open DOCINPUT, "<${FILE}" or die;
 
884
        $source = <DOCINPUT>;
 
885
        close DOCINPUT;
 
886
    }
 
887
    if ($source =~ /(<!DOCTYPE.*\[.*\]\s*>)/s)
 
888
    {
 
889
        print $fh "$1\n";
 
890
    }
 
891
    elsif ($source =~ /(<!DOCTYPE[^>]*>)/s)
 
892
    {
 
893
        print $fh "$1\n";
 
894
    }
 
895
}
 
896
 
 
897
sub parseTree
 
898
{
 
899
    my $fh        = shift;
 
900
    my $ref       = shift;
 
901
    my $language  = shift || "";
 
902
 
 
903
    my $name = shift @{ $ref };
 
904
    my $cont = shift @{ $ref };
 
905
    traverse($fh, $name, $cont, $language);
 
906
}
 
907
 
 
908
sub xml_merge_output
 
909
{
 
910
    my $source;
 
911
 
 
912
    if ($MULTIPLE_OUTPUT) {
 
913
        for my $lang (sort keys %po_files_by_lang) {
 
914
            if ( ! -e $lang ) {
 
915
                mkdir $lang or die "Cannot create subdirectory $lang: $!\n";
 
916
            }
 
917
            open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
 
918
            my $tree = readXml($FILE);
 
919
            print_header($FILE, \*OUTPUT);
 
920
            parseTree(\*OUTPUT, $tree, $lang);
 
921
            close OUTPUT;
 
922
            print "CREATED $lang/$OUTFILE\n" unless $QUIET_ARG;
627
923
        }
628
 
    }
629
 
 
630
 
    print OUTPUT $source;
631
 
 
 
924
    } 
 
925
    open OUTPUT, ">$OUTFILE" or die "Cannot open $OUTFILE: $!\n";
 
926
    my $tree = readXml($FILE);
 
927
    print_header($FILE, \*OUTPUT);
 
928
    parseTree(\*OUTPUT, $tree);
632
929
    close OUTPUT;
 
930
    print "CREATED $OUTFILE\n" unless $QUIET_ARG;
633
931
}
634
932
 
635
933
sub keys_merge_translations
724
1022
    while ($source =~ s/
725
1023
                        (.*?)
726
1024
                        (\s+)(<locale\ name="C">(\s*)
727
 
                            (<default>\s*(.*?)\s*<\/default>)?(\s*)
728
 
                            (<short>\s*(.*?)\s*<\/short>)?(\s*)
729
 
                            (<long>\s*(.*?)\s*<\/long>)?(\s*)
 
1025
                            (<default>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/default>)?(\s*)
 
1026
                            (<short>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/short>)?(\s*)
 
1027
                            (<long>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/long>)?(\s*)
730
1028
                        <\/locale>)
731
1029
                       //sx) 
732
1030
    {
742
1040
        my $short_string = $9 ? $9 : '';
743
1041
        my $long_string = $12 ? $12 : '';
744
1042
 
745
 
        $c_default_block =~ s/default>\[.*?\]/default>/s;
746
 
        
747
1043
        print OUTPUT "$locale_start_spaces$c_default_block";
748
1044
 
749
1045
        $default_string =~ s/\s+/ /g;
799
1095
 
800
1096
sub rfc822deb_merge_translations
801
1097
{
 
1098
    my %encodings = ();
 
1099
    for my $lang (keys %po_files_by_lang) {
 
1100
        $encodings{$lang} = ($UTF8_ARG ? 'UTF-8' : get_po_encoding($po_files_by_lang{$lang}));
 
1101
    }
 
1102
 
802
1103
    my $source;
803
1104
 
804
1105
    $Text::Wrap::huge = 'overflow';
 
1106
    $Text::Wrap::break = qr/\n|\s(?=\S)/;
805
1107
 
806
1108
    {
807
1109
       local $/; # slurp mode
812
1114
 
813
1115
    open OUTPUT, ">${OUTFILE}" or die;
814
1116
 
815
 
    while ($source =~ /(^|\n+)(_)?([^:_\n]+)(:\s*)(.*?)(?=\n[\S\n]|$)/sg) 
 
1117
    while ($source =~ /(^|\n+)(_*)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg)
816
1118
    {
817
1119
            my $sep = $1;
818
1120
            my $non_translated_line = $3.$4;
819
1121
            my $string = $5;
820
 
            my $is_translatable = defined($2);
 
1122
            my $underscore = length($2);
 
1123
            next if $underscore eq 0 && $non_translated_line =~ /^#/;
821
1124
            #  Remove [] dummy strings
822
 
            $string =~ s/\[\s[^\[\]]*\]$//;
823
 
            $non_translated_line .= $string;
 
1125
            my $stripped = $string;
 
1126
            $stripped =~ s/\[\s[^\[\]]*\],/,/g if $underscore eq 2;
 
1127
            $stripped =~ s/\[\s[^\[\]]*\]$//;
 
1128
            $non_translated_line .= $stripped;
824
1129
 
825
 
            print OUTPUT $sep.$non_translated_line;
 
1130
            print OUTPUT $sep.$non_translated_line;
826
1131
    
827
 
            if ($is_translatable) 
828
 
            {
829
 
                my @str_list = rfc822deb_split($string);
830
 
           
 
1132
            if ($underscore) 
 
1133
            {
 
1134
                my @str_list = rfc822deb_split($underscore, $string);
 
1135
 
831
1136
                for my $lang (sort keys %po_files_by_lang) 
832
1137
                {
833
1138
                    my $is_translated = 1;
850
1155
                        
851
1156
                        if ($first) 
852
1157
                        {
853
 
                            $str_translated .=
854
 
                                Text::Tabs::expand($translation) .
855
 
                                "\n";
 
1158
                            if ($underscore eq 2)
 
1159
                            {
 
1160
                                $str_translated .= $translation;
 
1161
                            }
 
1162
                            else
 
1163
                            {
 
1164
                                $str_translated .=
 
1165
                                    Text::Tabs::expand($translation) .
 
1166
                                    "\n";
 
1167
                            }
856
1168
                        } 
857
1169
                        else 
858
1170
                        {
859
 
                            $str_translated .= Text::Tabs::expand(
860
 
                                Text::Wrap::wrap(' ', ' ', $translation)) .
861
 
                                "\n .\n";
 
1171
                            if ($underscore eq 2)
 
1172
                            {
 
1173
                                $str_translated .= ', ' . $translation;
 
1174
                            }
 
1175
                            else
 
1176
                            {
 
1177
                                $str_translated .= Text::Tabs::expand(
 
1178
                                    Text::Wrap::wrap(' ', ' ', $translation)) .
 
1179
                                    "\n .\n";
 
1180
                            }
862
1181
                        }
863
1182
                        $first = 0;
864
1183
 
871
1190
                    $str_translated =~ s/\s+$//;
872
1191
 
873
1192
                    $_ = $non_translated_line;
874
 
                    s/^(\w+):\s*.*/$sep${1}-$lang: $str_translated/s;
 
1193
                    s/^(\w+):\s*.*/$sep${1}-$lang.$encodings{$lang}: $str_translated/s;
875
1194
                    print OUTPUT;
876
1195
                }
877
 
            }
 
1196
            }
878
1197
    }
879
1198
    print OUTPUT "\n";
880
1199
 
891
1210
    #       and paragraphs are separated by a single dot on a line
892
1211
    # This routine returns an array of all paragraphs, and reformat
893
1212
    # them.
 
1213
    # When first argument is 2, the string is a comma separated list of
 
1214
    # values.
 
1215
    my $type = shift;
894
1216
    my $text = shift;
895
 
    $text =~ s/^ //mg;
 
1217
    $text =~ s/^[ \t]//mg;
 
1218
    return (split(/, */, $text, 0)) if $type ne 1;
896
1219
    return ($text) if $text !~ /\n/;
897
1220
 
898
1221
    $text =~ s/([^\n]*)\n//;
902
1225
    for my $line (split (/\n/, $text)) 
903
1226
    {
904
1227
        chomp $line;
905
 
        $line =~ /\s+$/;
906
 
    
907
 
        if ($line =~ /^\.$/) 
 
1228
        if ($line =~ /^\.\s*$/)
908
1229
        {
909
1230
            #  New paragraph
910
1231
            $str =~ s/\s*$//;
915
1236
        {
916
1237
            #  Line which must not be reformatted
917
1238
            $str .= "\n" if length ($str) && $str !~ /\n$/;
 
1239
            $line =~ s/\s+$//;
918
1240
            $str .= $line."\n";
919
1241
        } 
920
1242
        else 
921
1243
        {
922
1244
            #  Continuation line, remove newline
923
 
            $str .= " " if length ($str) && $str !~ /[\n ]$/;
 
1245
            $str .= " " if length ($str) && $str !~ /\n$/;
924
1246
            $str .= $line;
925
1247
        }
926
1248
    }