← Back to branch summary

~ubuntu-branches/ubuntu/hardy/gnome-commander/hardy

« back to all changes in this revision

Viewing changes to intltool-merge.in

  • Committer: Bazaar Package Importer
  • Author(s): Michael Vogt
  • Date: 2006-06-13 15:39:48 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20060613153948-gvrt3mb2ddk5u62o
Tags: 1.2.0-3
added --disable-scrollkeeper on build

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