← Back to branch summary

~ubuntu-branches/ubuntu/wily/xfce4-appfinder/wily-proposed

« back to all changes in this revision

Viewing changes to intltool-merge.in

  • Committer: Bazaar Package Importer
  • Author(s): Simon Huggins, Yves-Alexis Perez, Simon Huggins
  • Date: 2007-11-27 16:39:17 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20071127163917-b6no7r2t7ee1gy0h
Tags: 4.4.2-1
[ Yves-Alexis Perez ]
* New upstream release.
* debian/menu: switch to new menu policy.
* debian/rules: don't ignore all make errors at clean stage.

[ Simon Huggins ]
* debian/control: Move fake Homepage field to a real one now dpkg
  supports it.
* Add Vcs-* headers to debian/control

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.33";
 
38
my $VERSION = "0.35.5";
39
39
 
40
40
## Loaded modules
41
41
use strict; 
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;
63
64
my $QUIET_ARG = 0;
64
65
my $PASS_THROUGH_ARG = 0;
65
66
my $UTF8_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,
91
93
 
92
94
my %po_files_by_lang = ();
93
95
my %translations = ();
94
 
my $iconv = $ENV{"ICONV"} || $ENV{"INTLTOOL_ICONV"} || "/usr/local/bin/iconv";
 
96
my $iconv = $ENV{"ICONV"} || $ENV{"INTLTOOL_ICONV"} || "@INTLTOOL_ICONV@";
 
97
my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null');
95
98
 
96
99
# Use this instead of \w for XML files to handle more possible characters.
97
100
my $w = "[-A-Za-z0-9._:]";
156
159
        &rfc822deb_merge_translations;
157
160
        &finalize;
158
161
} 
 
162
elsif ($QUOTED_STYLE_ARG && @ARGV > 2) 
 
163
{
 
164
        &utf8_sanity_check;
 
165
        &preparation;
 
166
        &print_message;
 
167
        &quoted_merge_translations;
 
168
        &finalize;
 
169
} 
159
170
else 
160
171
{
161
172
        &print_help;
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
196
208
 
197
209
Other options:
256
268
sub get_local_charset
257
269
{
258
270
    my ($encoding) = @_;
259
 
    my $alias_file = $ENV{"G_CHARSET_ALIAS"} || "/opt/local/lib/charset.alias";
 
271
    my $alias_file = $ENV{"G_CHARSET_ALIAS"} || "@INTLTOOL_LIBDIR@/charset.alias";
260
272
 
261
273
    # seek character encoding aliases in charset.alias (glib)
262
274
 
299
311
        $encoding = "ISO-8859-1";
300
312
    }
301
313
 
302
 
    system ("$iconv -f $encoding -t UTF-8 </dev/null 2>/dev/null");
 
314
    system ("$iconv -f $encoding -t UTF-8 <$devnull 2>$devnull");
303
315
    if ($?) {
304
316
        $encoding = get_local_charset($encoding);
305
317
    }
394
406
            } 
395
407
            else 
396
408
            {
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;;
398
410
 
399
411
                open PO_FILE, "$iconv -f $encoding -t UTF-8 $po_file|"; 
400
412
            }
414
426
        {
415
427
            $nextfuzzy = 1 if /^#, fuzzy/;
416
428
       
417
 
            if (/^msgid "((\\.|[^\\])*)"/ ) 
 
429
            if (/^msgid "((\\.|[^\\]+)*)"/ ) 
418
430
            {
419
431
                $translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr;
420
432
                $msgid = "";
430
442
                $nextfuzzy = 0;
431
443
            }
432
444
 
433
 
            if (/^msgstr "((\\.|[^\\])*)"/) 
 
445
            if (/^msgstr "((\\.|[^\\]+)*)"/) 
434
446
            {
435
447
                $msgstr = unescape_po_string($1);
436
448
                $inmsgstr = 1;
437
449
                $inmsgid = 0;
438
450
            }
439
451
 
440
 
            if (/^"((\\.|[^\\])*)"/) 
 
452
            if (/^"((\\.|[^\\]+)*)"/) 
441
453
            {
442
454
                $msgid .= unescape_po_string($1) if $inmsgid;
443
455
                $msgstr .= unescape_po_string($1) if $inmsgstr;
542
554
    }
543
555
 
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';
545
559
 
546
560
    while ($source =~ s|^(.*?)([ \t]*<\s*$w+\s+($w+\s*=\s*"$q"\s*)+/?>)([ \t]*\n)?||s) 
547
561
    {
610
624
        if ($do_translate && $key =~ /^_/) {
611
625
            $key =~ s|^_||g;
612
626
            if ($language) {
613
 
                
614
627
                # Handle translation
615
 
                #
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;
621
 
                    $$translate = 2;
622
 
                } else {
623
 
                    $$translate = 2; # we still want translations for deep nesting (FIXME: this will cause
624
 
                                     # problems since we might get untranslated duplicated entries, but with xml:lang set)
625
 
                    # Fix would be to set it here to eg. 3, and do a check in traverse() to see if any of the containing tags
626
 
                    # really need translation, and only emit "translation" if there is (this means parsing same data twice)
627
633
                }
 
634
                $$translate = 2;
628
635
            } else {
629
 
                 $$translate = 2 if ($translate && (!$$translate)); # watch not to "overwrite" if $translate == 2
 
636
                 $$translate = 2 if ($translate && (!$$translate)); # watch not to "overwrite" $translate
630
637
            }
631
638
        }
632
639
        
636
643
}
637
644
 
638
645
# Returns a translatable string from XML node, it works on contents of every node in XML::Parser tree
639
 
#   doesn't support nesting of translatable tags (i.e. <_blah>this <_doh>doesn't</_doh> work</_blah> -- besides
640
 
#   can you define the correct semantics for this?)
641
 
#
642
 
 
643
646
sub getXMLstring
644
647
{
645
648
    my $ref = shift;
 
649
    my $spacepreserve = shift || 0;
646
650
    my @list = @{ $ref };
647
651
    my $result = "";
648
652
 
650
654
    my $attrs = $list[0];
651
655
    my $index = 1;
652
656
 
 
657
    $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
 
658
    $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
 
659
 
653
660
    while ($index < $count) {
654
661
        my $type = $list[$index];
655
662
        my $content = $list[$index+1];
657
664
            # We've got CDATA
658
665
            if ($content) {
659
666
                # lets strip the whitespace here, and *ONLY* here
660
 
                $content =~ s/\s+/ /gs if (!((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)));
661
 
                $result .= ($content);
662
 
            } else {
663
 
                #print "no cdata content when expected it\n"; # is this possible, is this ok?
664
 
                # what to do if this happens?
665
 
                # Did I mention that I hate XML::Parser tree style?
 
667
                $content =~ s/\s+/ /gs if (!$spacepreserve);
 
668
                $result .= $content;
666
669
            }
667
 
        } else {
 
670
        } elsif ( "$type" ne "1" ) {
668
671
            # We've got another element
669
672
            $result .= "<$type";
670
673
            $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements
671
674
            if ($content) {
672
 
                my $subresult = getXMLstring($content);
 
675
                my $subresult = getXMLstring($content, $spacepreserve);
673
676
                if ($subresult) {
674
677
                    $result .= ">".$subresult . "</$type>";
675
678
                } else {
691
694
    my $content = shift;
692
695
    my $language = shift || "";
693
696
    my $singlelang = shift || 0;
 
697
    my $spacepreserve = shift || 0;
694
698
 
695
699
    my @nodes = @{ $content };
696
700
 
702
706
        if ($singlelang) {
703
707
            my $oldMO = $MULTIPLE_OUTPUT;
704
708
            $MULTIPLE_OUTPUT = 1;
705
 
            traverse($fh, $type, $rest, $language);
 
709
            traverse($fh, $type, $rest, $language, $spacepreserve);
706
710
            $MULTIPLE_OUTPUT = $oldMO;
707
711
        } else {
708
 
            traverse($fh, $type, $rest, $language);
 
712
            traverse($fh, $type, $rest, $language, $spacepreserve);
709
713
        }
710
714
        $index += 2;
711
715
    }
712
716
}
713
717
 
 
718
sub isWellFormedXmlFragment
 
719
{
 
720
    my $ret = eval 'require XML::Parser';
 
721
    if(!$ret) {
 
722
        die "You must have XML::Parser installed to run $0\n\n";
 
723
    } 
 
724
 
 
725
    my $fragment = shift;
 
726
    return 0 if (!$fragment);
 
727
 
 
728
    $fragment = "<root>$fragment</root>";
 
729
    my $xp = new XML::Parser(Style => 'Tree');
 
730
    my $tree = 0;
 
731
    eval { $tree = $xp->parse($fragment); };
 
732
    return $tree;
 
733
}
 
734
 
714
735
sub traverse
715
736
{
716
737
    my $fh = shift; 
717
738
    my $nodename = shift;
718
739
    my $content = shift;
719
740
    my $language = shift || "";
 
741
    my $spacepreserve = shift || 0;
720
742
 
721
743
    if (!$nodename) {
722
744
        if ($content =~ /^[\s]*$/) {
735
757
            $nodename =~ s/^_//;
736
758
        }
737
759
        my $lookup = '';
 
760
 
 
761
        $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
 
762
        $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
 
763
 
738
764
        print $fh "<$nodename", $outattr;
739
765
        if ($translate) {
740
 
            $lookup = getXMLstring($content);
741
 
            if (!((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/))) {
 
766
            $lookup = getXMLstring($content, $spacepreserve);
 
767
            if (!$spacepreserve) {
742
768
                $lookup =~ s/^\s+//s;
743
769
                $lookup =~ s/\s+$//s;
744
770
            }
745
771
 
746
772
            if ($lookup || $translate == 2) {
747
 
                my $translation = $translations{$language, $lookup};
 
773
                my $translation = $translations{$language, $lookup} if isWellFormedXmlFragment($translations{$language, $lookup});
748
774
                if ($MULTIPLE_OUTPUT && ($translation || $translate == 2)) {
749
775
                    $translation = $lookup if (!$translation);
750
776
                    print $fh " xml:lang=\"", $language, "\"" if $language;
751
777
                    print $fh ">";
752
778
                    if ($translate == 2) {
753
 
                        translate_subnodes($fh, \@all, $language, 1);
 
779
                        translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
754
780
                    } else {
755
781
                        print $fh $translation;
756
782
                    }
761
787
                } else {
762
788
                    print $fh ">";
763
789
                    if ($translate == 2) {
764
 
                        translate_subnodes($fh, \@all, $language, 1);
 
790
                        translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
765
791
                    } else {
766
792
                        print $fh $lookup;
767
793
                    }
780
806
                        #
781
807
                        my $translate = 0;
782
808
                        my $localattrs = getAttributeString($attrs, 1, $lang, \$translate);
783
 
                        my $translation = $translations{$lang, $lookup};
 
809
                        my $translation = $translations{$lang, $lookup} if isWellFormedXmlFragment($translations{$lang, $lookup});
784
810
                        if ($translate && !$translation) {
785
811
                            $translation = $lookup;
786
812
                        }
791
817
                            print $fh $leading_space;
792
818
                            print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs, ">";
793
819
                            if ($translate == 2) {
794
 
                               translate_subnodes($fh, \@all, $lang, 1);
 
820
                               translate_subnodes($fh, \@all, $lang, 1, $spacepreserve);
795
821
                            } else {
796
822
                                print $fh $translation;
797
823
                            }
808
834
                while ($index < $count) {
809
835
                    my $type = $all[$index];
810
836
                    my $rest = $all[$index+1];
811
 
                    traverse($fh, $type, $rest, $language);
 
837
                    traverse($fh, $type, $rest, $language, $spacepreserve);
812
838
                    $index += 2;
813
839
                }
814
840
                print $fh "</$nodename>";
819
845
    }
820
846
}
821
847
 
 
848
sub intltool_tree_comment
 
849
{
 
850
    my $expat = shift;
 
851
    my $data  = shift;
 
852
    my $clist = $expat->{Curlist};
 
853
    my $pos   = $#$clist;
 
854
 
 
855
    push @$clist, 1 => $data;
 
856
}
 
857
 
822
858
sub intltool_tree_cdatastart
823
859
{
824
860
    my $expat    = shift;
962
998
 
963
999
    my $name = shift @{ $ref };
964
1000
    my $cont = shift @{ $ref };
965
 
    traverse($fh, $name, $cont, $language);
 
1001
    
 
1002
    while (!$name || "$name" eq "1") {
 
1003
        $name = shift @{ $ref };
 
1004
        $cont = shift @{ $ref };
 
1005
    }
 
1006
 
 
1007
    my $spacepreserve = 0;
 
1008
    my $attrs = @{$cont}[0];
 
1009
    $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
 
1010
 
 
1011
    traverse($fh, $name, $cont, $language, $spacepreserve);
966
1012
}
967
1013
 
968
1014
sub xml_merge_output
971
1017
 
972
1018
    if ($MULTIPLE_OUTPUT) {
973
1019
        for my $lang (sort keys %po_files_by_lang) {
974
 
            if ( ! -e $lang ) {
975
 
                mkdir $lang or die "Cannot create subdirectory $lang: $!\n";
 
1020
            if ( ! -d $lang ) {
 
1021
                mkdir $lang or -d $lang or die "Cannot create subdirectory $lang: $!\n";
976
1022
            }
977
1023
            open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
 
1024
            binmode (OUTPUT) if $^O eq 'MSWin32';
978
1025
            my $tree = readXml($FILE);
979
1026
            print_header($FILE, \*OUTPUT);
980
1027
            parseTree(\*OUTPUT, $tree, $lang);
983
1030
        }
984
1031
    } 
985
1032
    open OUTPUT, ">$OUTFILE" or die "Cannot open $OUTFILE: $!\n";
 
1033
    binmode (OUTPUT) if $^O eq 'MSWin32';
986
1034
    my $tree = readXml($FILE);
987
1035
    print_header($FILE, \*OUTPUT);
988
1036
    parseTree(\*OUTPUT, $tree);
994
1042
{
995
1043
    open INPUT, "<${FILE}" or die;
996
1044
    open OUTPUT, ">${OUTFILE}" or die;
 
1045
    binmode (OUTPUT) if $^O eq 'MSWin32';
997
1046
 
998
1047
    while (<INPUT>) 
999
1048
    {
1029
1078
{
1030
1079
    open INPUT, "<${FILE}" or die;
1031
1080
    open OUTPUT, ">${OUTFILE}" or die;
 
1081
    binmode (OUTPUT) if $^O eq 'MSWin32';
1032
1082
 
1033
1083
    while (<INPUT>) 
1034
1084
    {
1072
1122
    }
1073
1123
 
1074
1124
    open OUTPUT, ">$OUTFILE" or die;
 
1125
    binmode (OUTPUT) if $^O eq 'MSWin32';
1075
1126
 
1076
1127
    # FIXME: support attribute translations
1077
1128
 
1173
1224
    }
1174
1225
 
1175
1226
    open OUTPUT, ">${OUTFILE}" or die;
 
1227
    binmode (OUTPUT) if $^O eq 'MSWin32';
1176
1228
 
1177
1229
    while ($source =~ /(^|\n+)(_*)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg)
1178
1230
    {
1313
1365
    return @list;
1314
1366
}
1315
1367
 
 
1368
sub quoted_translation
 
1369
{
 
1370
    my ($lang, $string) = @_;
 
1371
 
 
1372
    $string =~ s/\\\"/\"/g;
 
1373
 
 
1374
    my $translation = $translations{$lang, $string};
 
1375
    $translation = $string if !$translation;
 
1376
 
 
1377
    $translation =~ s/\"/\\\"/g;
 
1378
    return $translation
 
1379
}
 
1380
 
 
1381
sub quoted_merge_translations
 
1382
{
 
1383
    if (!$MULTIPLE_OUTPUT) {
 
1384
        print "Quoted only supports Multiple Output.\n";
 
1385
        exit(1);
 
1386
    }
 
1387
 
 
1388
    for my $lang (sort keys %po_files_by_lang) {
 
1389
        if ( ! -d $lang ) {
 
1390
            mkdir $lang or -d $lang or die "Cannot create subdirectory $lang: $!\n";
 
1391
        }
 
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';
 
1395
        while (<INPUT>) 
 
1396
        {
 
1397
            s/\"(([^\"]|\\\")*[^\\\"])\"/"\"" . &quoted_translation($lang, $1) . "\""/ge;
 
1398
            print OUTPUT;
 
1399
        }
 
1400
        close OUTPUT;
 
1401
        close INPUT;
 
1402
    }
 
1403
}