← Back to branch summary

~noskcaj/ubuntu/vivid/xfce4-netload-plugin/1.2.4

« back to all changes in this revision

Viewing changes to intltool-merge.in

  • Committer: Bazaar Package Importer
  • Author(s): Yves-Alexis Perez, Simon Huggins, Yves-Alexis Perez
  • Date: 2009-03-01 11:39:32 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090301113932-avvah7fe1iuzzo1h
Tags: 0.4.0-1
[ Simon Huggins ]
* debian/control: Move fake Homepage field to a real one now dpkg
  supports it.
* Add Vcs-* headers to debian/control

[ Yves-Alexis Perez ]
* Fake new upstream release to follow package renaming.
* debian/control:
  - update my email address.
  - remove Rudy and Martin from Uploaders. Thanks to them!
  - update standards version to 3.8.0.
  - add dep on ${misc:Depends}. 
* debian/copyright: update dates, and license information.

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.34.1";
 
38
my $VERSION = "0.33";
39
39
 
40
40
## Loaded modules
41
41
use strict; 
92
92
my %po_files_by_lang = ();
93
93
my %translations = ();
94
94
my $iconv = $ENV{"ICONV"} || $ENV{"INTLTOOL_ICONV"} || "/usr/bin/iconv";
95
 
my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null');
96
95
 
97
96
# Use this instead of \w for XML files to handle more possible characters.
98
97
my $w = "[-A-Za-z0-9._:]";
300
299
        $encoding = "ISO-8859-1";
301
300
    }
302
301
 
303
 
    system ("$iconv -f $encoding -t UTF-8 <$devnull 2>$devnull");
 
302
    system ("$iconv -f $encoding -t UTF-8 </dev/null 2>/dev/null");
304
303
    if ($?) {
305
304
        $encoding = get_local_charset($encoding);
306
305
    }
543
542
    }
544
543
 
545
544
    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';
548
545
 
549
546
    while ($source =~ s|^(.*?)([ \t]*<\s*$w+\s+($w+\s*=\s*"$q"\s*)+/?>)([ \t]*\n)?||s) 
550
547
    {
613
610
        if ($do_translate && $key =~ /^_/) {
614
611
            $key =~ s|^_||g;
615
612
            if ($language) {
 
613
                
616
614
                # Handle translation
 
615
                #
617
616
                my $decode_string = entity_decode($string);
618
617
                my $translation = $translations{$language, $decode_string};
619
618
                if ($translation) {
620
619
                    $translation = entity_encode($translation);
621
620
                    $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)
622
627
                }
623
 
                $$translate = 2;
624
628
            } else {
625
 
                 $$translate = 2 if ($translate && (!$$translate)); # watch not to "overwrite" $translate
 
629
                 $$translate = 2 if ($translate && (!$$translate)); # watch not to "overwrite" if $translate == 2
626
630
            }
627
631
        }
628
632
        
632
636
}
633
637
 
634
638
# 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
 
635
643
sub getXMLstring
636
644
{
637
645
    my $ref = shift;
638
 
    my $spacepreserve = shift || 0;
639
646
    my @list = @{ $ref };
640
647
    my $result = "";
641
648
 
643
650
    my $attrs = $list[0];
644
651
    my $index = 1;
645
652
 
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
 
 
649
653
    while ($index < $count) {
650
654
        my $type = $list[$index];
651
655
        my $content = $list[$index+1];
653
657
            # We've got CDATA
654
658
            if ($content) {
655
659
                # lets strip the whitespace here, and *ONLY* here
656
 
                $content =~ s/\s+/ /gs if (!$spacepreserve);
657
 
                $result .= $content;
 
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?
658
666
            }
659
 
        } elsif ( "$type" ne "1" ) {
 
667
        } else {
660
668
            # We've got another element
661
669
            $result .= "<$type";
662
670
            $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements
663
671
            if ($content) {
664
 
                my $subresult = getXMLstring($content, $spacepreserve);
 
672
                my $subresult = getXMLstring($content);
665
673
                if ($subresult) {
666
674
                    $result .= ">".$subresult . "</$type>";
667
675
                } else {
683
691
    my $content = shift;
684
692
    my $language = shift || "";
685
693
    my $singlelang = shift || 0;
686
 
    my $spacepreserve = shift || 0;
687
694
 
688
695
    my @nodes = @{ $content };
689
696
 
695
702
        if ($singlelang) {
696
703
            my $oldMO = $MULTIPLE_OUTPUT;
697
704
            $MULTIPLE_OUTPUT = 1;
698
 
            traverse($fh, $type, $rest, $language, $spacepreserve);
 
705
            traverse($fh, $type, $rest, $language);
699
706
            $MULTIPLE_OUTPUT = $oldMO;
700
707
        } else {
701
 
            traverse($fh, $type, $rest, $language, $spacepreserve);
 
708
            traverse($fh, $type, $rest, $language);
702
709
        }
703
710
        $index += 2;
704
711
    }
705
712
}
706
713
 
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
 
 
724
714
sub traverse
725
715
{
726
716
    my $fh = shift; 
727
717
    my $nodename = shift;
728
718
    my $content = shift;
729
719
    my $language = shift || "";
730
 
    my $spacepreserve = shift || 0;
731
720
 
732
721
    if (!$nodename) {
733
722
        if ($content =~ /^[\s]*$/) {
746
735
            $nodename =~ s/^_//;
747
736
        }
748
737
        my $lookup = '';
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
738
        print $fh "<$nodename", $outattr;
754
739
        if ($translate) {
755
 
            $lookup = getXMLstring($content, $spacepreserve);
756
 
            if (!$spacepreserve) {
 
740
            $lookup = getXMLstring($content);
 
741
            if (!((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/))) {
757
742
                $lookup =~ s/^\s+//s;
758
743
                $lookup =~ s/\s+$//s;
759
744
            }
760
745
 
761
746
            if ($lookup || $translate == 2) {
762
 
                my $translation = $translations{$language, $lookup} if isWellFormedXmlFragment($translations{$language, $lookup});
 
747
                my $translation = $translations{$language, $lookup};
763
748
                if ($MULTIPLE_OUTPUT && ($translation || $translate == 2)) {
764
749
                    $translation = $lookup if (!$translation);
765
750
                    print $fh " xml:lang=\"", $language, "\"" if $language;
766
751
                    print $fh ">";
767
752
                    if ($translate == 2) {
768
 
                        translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
 
753
                        translate_subnodes($fh, \@all, $language, 1);
769
754
                    } else {
770
755
                        print $fh $translation;
771
756
                    }
776
761
                } else {
777
762
                    print $fh ">";
778
763
                    if ($translate == 2) {
779
 
                        translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
 
764
                        translate_subnodes($fh, \@all, $language, 1);
780
765
                    } else {
781
766
                        print $fh $lookup;
782
767
                    }
795
780
                        #
796
781
                        my $translate = 0;
797
782
                        my $localattrs = getAttributeString($attrs, 1, $lang, \$translate);
798
 
                        my $translation = $translations{$lang, $lookup} if isWellFormedXmlFragment($translations{$lang, $lookup});
 
783
                        my $translation = $translations{$lang, $lookup};
799
784
                        if ($translate && !$translation) {
800
785
                            $translation = $lookup;
801
786
                        }
806
791
                            print $fh $leading_space;
807
792
                            print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs, ">";
808
793
                            if ($translate == 2) {
809
 
                               translate_subnodes($fh, \@all, $lang, 1, $spacepreserve);
 
794
                               translate_subnodes($fh, \@all, $lang, 1);
810
795
                            } else {
811
796
                                print $fh $translation;
812
797
                            }
823
808
                while ($index < $count) {
824
809
                    my $type = $all[$index];
825
810
                    my $rest = $all[$index+1];
826
 
                    traverse($fh, $type, $rest, $language, $spacepreserve);
 
811
                    traverse($fh, $type, $rest, $language);
827
812
                    $index += 2;
828
813
                }
829
814
                print $fh "</$nodename>";
834
819
    }
835
820
}
836
821
 
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
822
sub intltool_tree_cdatastart
848
823
{
849
824
    my $expat    = shift;
987
962
 
988
963
    my $name = shift @{ $ref };
989
964
    my $cont = shift @{ $ref };
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);
 
965
    traverse($fh, $name, $cont, $language);
1001
966
}
1002
967
 
1003
968
sub xml_merge_output
1010
975
                mkdir $lang or die "Cannot create subdirectory $lang: $!\n";
1011
976
            }
1012
977
            open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
1013
 
            binmode (OUTPUT) if $^O eq 'MSWin32';
1014
978
            my $tree = readXml($FILE);
1015
979
            print_header($FILE, \*OUTPUT);
1016
980
            parseTree(\*OUTPUT, $tree, $lang);
1019
983
        }
1020
984
    } 
1021
985
    open OUTPUT, ">$OUTFILE" or die "Cannot open $OUTFILE: $!\n";
1022
 
    binmode (OUTPUT) if $^O eq 'MSWin32';
1023
986
    my $tree = readXml($FILE);
1024
987
    print_header($FILE, \*OUTPUT);
1025
988
    parseTree(\*OUTPUT, $tree);
1031
994
{
1032
995
    open INPUT, "<${FILE}" or die;
1033
996
    open OUTPUT, ">${OUTFILE}" or die;
1034
 
    binmode (OUTPUT) if $^O eq 'MSWin32';
1035
997
 
1036
998
    while (<INPUT>) 
1037
999
    {
1067
1029
{
1068
1030
    open INPUT, "<${FILE}" or die;
1069
1031
    open OUTPUT, ">${OUTFILE}" or die;
1070
 
    binmode (OUTPUT) if $^O eq 'MSWin32';
1071
1032
 
1072
1033
    while (<INPUT>) 
1073
1034
    {
1111
1072
    }
1112
1073
 
1113
1074
    open OUTPUT, ">$OUTFILE" or die;
1114
 
    binmode (OUTPUT) if $^O eq 'MSWin32';
1115
1075
 
1116
1076
    # FIXME: support attribute translations
1117
1077
 
1213
1173
    }
1214
1174
 
1215
1175
    open OUTPUT, ">${OUTFILE}" or die;
1216
 
    binmode (OUTPUT) if $^O eq 'MSWin32';
1217
1176
 
1218
1177
    while ($source =~ /(^|\n+)(_*)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg)
1219
1178
    {