← Back to branch summary

~ubuntu-branches/ubuntu/hardy/uim/hardy

« back to all changes in this revision

Viewing changes to intltool-merge.in

  • Committer: Bazaar Package Importer
  • Author(s): Masahito Omote
  • Date: 2007-04-21 03:46:09 UTC
  • mfrom: (1.1.6 upstream)
  • Revision ID: james.westby@ubuntu.com-20070421034609-gpcurkutp8vaysqj
Tags: 1:1.4.1-3
* Switch to dh_gtkmodules for the gtk 2.10 transition (Closes:
  #419318)
  - debian/control: Add ${misc:Depends} and remove libgtk2.0-bin on
    uim-gtk2.0.
  - debian/uim-gtk2.0.post{inst,rm}: Removed.

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.35.4";
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{"INTLTOOL_ICONV"} || "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._:]";
111
114
} 
112
115
elsif ($BA_STYLE_ARG && @ARGV > 2) 
113
116
{
 
117
        &utf8_sanity_check;
114
118
        &preparation;
115
119
        &print_message;
116
120
        &ba_merge_translations;
118
122
} 
119
123
elsif ($XML_STYLE_ARG && @ARGV > 2) 
120
124
{
121
 
        &utf8_sanity_check;
 
125
        &utf8_sanity_check;
122
126
        &preparation;
123
127
        &print_message;
124
 
        
125
 
    &xml_merge_output;
126
 
 
 
128
        &xml_merge_output;
127
129
        &finalize;
128
130
} 
129
131
elsif ($KEYS_STYLE_ARG && @ARGV > 2) 
130
132
{
131
 
        &utf8_sanity_check;
132
 
        &preparation;
133
 
        &print_message;
134
 
        &keys_merge_translations;
 
133
        &utf8_sanity_check;
 
134
        &preparation;
 
135
        &print_message;
 
136
        &keys_merge_translations;
135
137
        &finalize;
136
138
} 
137
139
elsif ($DESKTOP_STYLE_ARG && @ARGV > 2) 
138
140
{
139
 
        &preparation;
140
 
        &print_message;
141
 
        &desktop_merge_translations;
 
141
        &utf8_sanity_check;
 
142
        &preparation;
 
143
        &print_message;
 
144
        &desktop_merge_translations;
142
145
        &finalize;
143
146
} 
144
147
elsif ($SCHEMAS_STYLE_ARG && @ARGV > 2) 
145
148
{
146
 
        &preparation;
147
 
        &print_message;
148
 
        &schemas_merge_translations;
 
149
        &utf8_sanity_check;
 
150
        &preparation;
 
151
        &print_message;
 
152
        &schemas_merge_translations;
149
153
        &finalize;
150
154
} 
151
155
elsif ($RFC822DEB_STYLE_ARG && @ARGV > 2) 
152
156
{
153
 
        &preparation;
154
 
        &print_message;
155
 
        &rfc822deb_merge_translations;
 
157
        &preparation;
 
158
        &print_message;
 
159
        &rfc822deb_merge_translations;
 
160
        &finalize;
 
161
} 
 
162
elsif ($QUOTED_STYLE_ARG && @ARGV > 2) 
 
163
{
 
164
        &utf8_sanity_check;
 
165
        &preparation;
 
166
        &print_message;
 
167
        &quoted_merge_translations;
156
168
        &finalize;
157
169
} 
158
170
else 
191
203
  -k, --keys-style       includes translations in the keys style
192
204
  -s, --schemas-style    includes translations in the schemas style
193
205
  -r, --rfc822deb-style  includes translations in the RFC822 style
 
206
      --quoted-style     includes translations in the quoted string style
194
207
  -x, --xml-style        includes translations in the standard xml style
195
208
 
196
209
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)
 
210
  -u, --utf8             convert all strings to UTF-8 before merging 
 
211
                         (default for everything except RFC822 style)
 
212
  -p, --pass-through     deprecated, does nothing and issues a warning
200
213
  -m, --multiple-output  output one localized file per locale, instead of 
201
214
                         a single file containing all localized elements
202
215
  -c, --cache=FILE       specify cache file name
255
268
sub get_local_charset
256
269
{
257
270
    my ($encoding) = @_;
258
 
    my $alias_file = $ENV{"G_CHARSET_ALIAS"} || "/usr/lib/charset.alias";
 
271
    my $alias_file = $ENV{"G_CHARSET_ALIAS"} || "@INTLTOOL_LIBDIR@/charset.alias";
259
272
 
260
273
    # seek character encoding aliases in charset.alias (glib)
261
274
 
298
311
        $encoding = "ISO-8859-1";
299
312
    }
300
313
 
301
 
    system ("$iconv -f $encoding -t UTF-8 </dev/null 2>/dev/null");
 
314
    system ("$iconv -f $encoding -t UTF-8 <$devnull 2>$devnull");
302
315
    if ($?) {
303
316
        $encoding = get_local_charset($encoding);
304
317
    }
308
321
 
309
322
sub utf8_sanity_check 
310
323
{
311
 
    if (!$UTF8_ARG) 
312
 
    {
313
 
        if (!$PASS_THROUGH_ARG) 
314
 
        {
315
 
            $PASS_THROUGH_ARG="1";
316
 
        }
317
 
    }
 
324
    print STDERR "Warning: option --pass-through has been removed.\n" if $PASS_THROUGH_ARG;
 
325
    $UTF8_ARG = 1;
318
326
}
319
327
 
320
328
sub get_translation_database
398
406
            } 
399
407
            else 
400
408
            {
401
 
                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;;
402
410
 
403
411
                open PO_FILE, "$iconv -f $encoding -t UTF-8 $po_file|"; 
404
412
            }
418
426
        {
419
427
            $nextfuzzy = 1 if /^#, fuzzy/;
420
428
       
421
 
            if (/^msgid "((\\.|[^\\])*)"/ ) 
 
429
            if (/^msgid "((\\.|[^\\]+)*)"/ ) 
422
430
            {
423
431
                $translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr;
424
432
                $msgid = "";
434
442
                $nextfuzzy = 0;
435
443
            }
436
444
 
437
 
            if (/^msgstr "((\\.|[^\\])*)"/) 
 
445
            if (/^msgstr "((\\.|[^\\]+)*)"/) 
438
446
            {
439
447
                $msgstr = unescape_po_string($1);
440
448
                $inmsgstr = 1;
441
449
                $inmsgid = 0;
442
450
            }
443
451
 
444
 
            if (/^"((\\.|[^\\])*)"/) 
 
452
            if (/^"((\\.|[^\\]+)*)"/) 
445
453
            {
446
454
                $msgid .= unescape_po_string($1) if $inmsgid;
447
455
                $msgstr .= unescape_po_string($1) if $inmsgstr;
462
470
    return "\\" if $sequence eq "\\\\";
463
471
    return "\"" if $sequence eq "\\\"";
464
472
    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.
 
473
    return "\r" if $sequence eq "\\r";
 
474
    return "\t" if $sequence eq "\\t";
 
475
    return "\b" if $sequence eq "\\b";
 
476
    return "\f" if $sequence eq "\\f";
 
477
    return "\a" if $sequence eq "\\a";
 
478
    return chr(11) if $sequence eq "\\v"; # vertical tab, see ascii(7)
 
479
 
 
480
    return chr(hex($1)) if ($sequence =~ /\\x([0-9a-fA-F]{2})/);
 
481
    return chr(oct($1)) if ($sequence =~ /\\([0-7]{3})/);
 
482
 
 
483
    # FIXME: Is \0 supported as well? Kenneth and Rodney don't want it, see bug #48489
468
484
 
469
485
    return $sequence;
470
486
}
473
489
{
474
490
    my ($string) = @_;
475
491
 
476
 
    $string =~ s/(\\.)/unescape_one_sequence($1)/eg;
 
492
    $string =~ s/(\\x[0-9a-fA-F]{2}|\\[0-7]{3}|\\.)/unescape_one_sequence($1)/eg;
477
493
 
478
494
    return $string;
479
495
}
494
510
 
495
511
# entity_encode: (string)
496
512
#
497
 
# Encode the given string to XML format (encode '<' etc). It also 
498
 
# encodes high bit if not in UTF-8 mode.
 
513
# Encode the given string to XML format (encode '<' etc).
499
514
 
500
515
sub entity_encode
501
516
{
503
518
 
504
519
    my @list_of_chars = unpack ('C*', $pre_encoded);
505
520
 
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
 
    }
 
521
    # with UTF-8 we only encode minimalistic
 
522
    return join ('', map (&entity_encode_int_minimalist, @list_of_chars));
515
523
}
516
524
 
517
525
sub entity_encode_int_minimalist
523
531
    return chr $_;
524
532
}
525
533
 
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
534
sub entity_encoded_translation
540
535
{
541
536
    my ($lang, $string) = @_;
559
554
    }
560
555
 
561
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';
562
559
 
563
560
    while ($source =~ s|^(.*?)([ \t]*<\s*$w+\s+($w+\s*=\s*"$q"\s*)+/?>)([ \t]*\n)?||s) 
564
561
    {
608
605
    my $do_translate = shift || 0;
609
606
    my $language = shift || "";
610
607
    my $result = "";
 
608
    my $translate = shift;
611
609
    foreach my $e (reverse(sort(keys %{ $sub }))) {
612
610
        my $key    = $e;
613
611
        my $string = $sub->{$e};
626
624
        if ($do_translate && $key =~ /^_/) {
627
625
            $key =~ s|^_||g;
628
626
            if ($language) {
629
 
                
630
627
                # Handle translation
631
 
                #
632
628
                my $decode_string = entity_decode($string);
633
629
                my $translation = $translations{$language, $decode_string};
634
630
                if ($translation) {
635
631
                    $translation = entity_encode($translation);
636
632
                    $string = $translation;
637
 
                }
638
 
            }
 
633
                }
 
634
                $$translate = 2;
 
635
            } else {
 
636
                 $$translate = 2 if ($translate && (!$$translate)); # watch not to "overwrite" $translate
 
637
            }
639
638
        }
640
639
        
641
640
        $result .= " $key=$quote$string$quote";
644
643
}
645
644
 
646
645
# 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
646
sub getXMLstring
652
647
{
653
648
    my $ref = shift;
 
649
    my $spacepreserve = shift || 0;
654
650
    my @list = @{ $ref };
655
651
    my $result = "";
656
652
 
657
653
    my $count = scalar(@list);
658
654
    my $attrs = $list[0];
659
655
    my $index = 1;
 
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
 
660
660
    while ($index < $count) {
661
661
        my $type = $list[$index];
662
662
        my $content = $list[$index+1];
664
664
            # We've got CDATA
665
665
            if ($content) {
666
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?
 
667
                $content =~ s/\s+/ /gs if (!$spacepreserve);
 
668
                $result .= $content;
673
669
            }
674
 
        } else {
 
670
        } elsif ( "$type" ne "1" ) {
675
671
            # We've got another element
676
672
            $result .= "<$type";
677
 
            $result .= getAttributeString($attrs, 0); # no nested translatable elements
 
673
            $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements
678
674
            if ($content) {
679
 
                my $subresult = getXMLstring($content);
 
675
                my $subresult = getXMLstring($content, $spacepreserve);
680
676
                if ($subresult) {
681
677
                    $result .= ">".$subresult . "</$type>";
682
678
                } else {
691
687
    return $result;
692
688
}
693
689
 
 
690
# Translate list of nodes if necessary
 
691
sub translate_subnodes
 
692
{
 
693
    my $fh = shift;
 
694
    my $content = shift;
 
695
    my $language = shift || "";
 
696
    my $singlelang = shift || 0;
 
697
    my $spacepreserve = shift || 0;
 
698
 
 
699
    my @nodes = @{ $content };
 
700
 
 
701
    my $count = scalar(@nodes);
 
702
    my $index = 0;
 
703
    while ($index < $count) {
 
704
        my $type = $nodes[$index];
 
705
        my $rest = $nodes[$index+1];
 
706
        if ($singlelang) {
 
707
            my $oldMO = $MULTIPLE_OUTPUT;
 
708
            $MULTIPLE_OUTPUT = 1;
 
709
            traverse($fh, $type, $rest, $language, $spacepreserve);
 
710
            $MULTIPLE_OUTPUT = $oldMO;
 
711
        } else {
 
712
            traverse($fh, $type, $rest, $language, $spacepreserve);
 
713
        }
 
714
        $index += 2;
 
715
    }
 
716
}
 
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
 
694
735
sub traverse
695
736
{
696
737
    my $fh = shift; 
697
738
    my $nodename = shift;
698
739
    my $content = shift;
699
740
    my $language = shift || "";
 
741
    my $spacepreserve = shift || 0;
700
742
 
701
743
    if (!$nodename) {
702
744
        if ($content =~ /^[\s]*$/) {
707
749
        # element
708
750
        my @all = @{ $content };
709
751
        my $attrs = shift @all;
710
 
        my $outattr = getAttributeString($attrs, 1, $language);
711
752
        my $translate = 0;
 
753
        my $outattr = getAttributeString($attrs, 1, $language, \$translate);
712
754
 
713
755
        if ($nodename =~ /^_/) {
714
756
            $translate = 1;
715
757
            $nodename =~ s/^_//;
716
758
        }
717
759
        my $lookup = '';
718
 
        print $fh "<$nodename$outattr";
 
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
 
 
764
        print $fh "<$nodename", $outattr;
719
765
        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>";
 
766
            $lookup = getXMLstring($content, $spacepreserve);
 
767
            if (!$spacepreserve) {
 
768
                $lookup =~ s/^\s+//s;
 
769
                $lookup =~ s/\s+$//s;
 
770
            }
 
771
 
 
772
            if ($lookup || $translate == 2) {
 
773
                my $translation = $translations{$language, $lookup} if isWellFormedXmlFragment($translations{$language, $lookup});
 
774
                if ($MULTIPLE_OUTPUT && ($translation || $translate == 2)) {
 
775
                    $translation = $lookup if (!$translation);
 
776
                    print $fh " xml:lang=\"", $language, "\"" if $language;
 
777
                    print $fh ">";
 
778
                    if ($translate == 2) {
 
779
                        translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
 
780
                    } else {
 
781
                        print $fh $translation;
 
782
                    }
 
783
                    print $fh "</$nodename>";
 
784
 
729
785
                    return; # this means there will be no same translation with xml:lang="$language"...
730
786
                            # if we want them both, just remove this "return"
731
787
                } else {
732
 
                    print $fh ">$lookup</$nodename>";
 
788
                    print $fh ">";
 
789
                    if ($translate == 2) {
 
790
                        translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
 
791
                    } else {
 
792
                        print $fh $lookup;
 
793
                    }
 
794
                    print $fh "</$nodename>";
733
795
                }
734
796
            } else {
735
797
                print $fh "/>";
736
798
            }
737
 
            
738
 
 
 
799
 
739
800
            for my $lang (sort keys %po_files_by_lang) {
740
801
                    if ($MULTIPLE_OUTPUT && $lang ne "$language") {
741
802
                        next;
742
803
                    }
743
804
                    if ($lang) {
744
 
 
745
805
                        # Handle translation
746
806
                        #
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);
 
807
                        my $translate = 0;
 
808
                        my $localattrs = getAttributeString($attrs, 1, $lang, \$translate);
 
809
                        my $translation = $translations{$lang, $lookup} if isWellFormedXmlFragment($translations{$lang, $lookup});
 
810
                        if ($translate && !$translation) {
 
811
                            $translation = $lookup;
 
812
                        }
 
813
 
 
814
                        if ($translation || $translate) {
752
815
                            print $fh "\n";
753
816
                            $leading_space =~ s/.*\n//g;
754
817
                            print $fh $leading_space;
755
 
                            print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs;
756
 
                            print $fh ">", $translation , "</$nodename>";
 
818
                            print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs, ">";
 
819
                            if ($translate == 2) {
 
820
                               translate_subnodes($fh, \@all, $lang, 1, $spacepreserve);
 
821
                            } else {
 
822
                                print $fh $translation;
 
823
                            }
 
824
                            print $fh "</$nodename>";
757
825
                        }
758
826
                    }
759
827
            }
762
830
            my $count = scalar(@all);
763
831
            if ($count > 0) {
764
832
                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) {
 
833
                my $index = 0;
 
834
                while ($index < $count) {
 
835
                    my $type = $all[$index];
 
836
                    my $rest = $all[$index+1];
 
837
                    traverse($fh, $type, $rest, $language, $spacepreserve);
 
838
                    $index += 2;
 
839
                }
776
840
                print $fh "</$nodename>";
 
841
            } else {
 
842
                print $fh "/>";
777
843
            }
778
844
        }
779
845
    }
780
846
}
781
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
 
 
858
sub intltool_tree_cdatastart
 
859
{
 
860
    my $expat    = shift;
 
861
    my $clist = $expat->{Curlist};
 
862
    my $pos   = $#$clist;
 
863
 
 
864
    push @$clist, 0 => $expat->original_string();
 
865
}
 
866
 
 
867
sub intltool_tree_cdataend
 
868
{
 
869
    my $expat    = shift;
 
870
    my $clist = $expat->{Curlist};
 
871
    my $pos   = $#$clist;
 
872
 
 
873
    $clist->[$pos] .= $expat->original_string();
 
874
}
 
875
 
782
876
sub intltool_tree_char
783
877
{
784
878
    my $expat = shift;
857
951
    my $xp = new XML::Parser(Style => 'Tree');
858
952
    $xp->setHandlers(Char => \&intltool_tree_char);
859
953
    $xp->setHandlers(Start => \&intltool_tree_start);
 
954
    $xp->setHandlers(CdataStart => \&intltool_tree_cdatastart);
 
955
    $xp->setHandlers(CdataEnd => \&intltool_tree_cdataend);
860
956
    my $tree = $xp->parsefile($filename);
861
957
 
862
958
# <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
902
998
 
903
999
    my $name = shift @{ $ref };
904
1000
    my $cont = shift @{ $ref };
905
 
    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);
906
1012
}
907
1013
 
908
1014
sub xml_merge_output
915
1021
                mkdir $lang or die "Cannot create subdirectory $lang: $!\n";
916
1022
            }
917
1023
            open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
 
1024
            binmode (OUTPUT) if $^O eq 'MSWin32';
918
1025
            my $tree = readXml($FILE);
919
1026
            print_header($FILE, \*OUTPUT);
920
1027
            parseTree(\*OUTPUT, $tree, $lang);
923
1030
        }
924
1031
    } 
925
1032
    open OUTPUT, ">$OUTFILE" or die "Cannot open $OUTFILE: $!\n";
 
1033
    binmode (OUTPUT) if $^O eq 'MSWin32';
926
1034
    my $tree = readXml($FILE);
927
1035
    print_header($FILE, \*OUTPUT);
928
1036
    parseTree(\*OUTPUT, $tree);
934
1042
{
935
1043
    open INPUT, "<${FILE}" or die;
936
1044
    open OUTPUT, ">${OUTFILE}" or die;
 
1045
    binmode (OUTPUT) if $^O eq 'MSWin32';
937
1046
 
938
1047
    while (<INPUT>) 
939
1048
    {
969
1078
{
970
1079
    open INPUT, "<${FILE}" or die;
971
1080
    open OUTPUT, ">${OUTFILE}" or die;
 
1081
    binmode (OUTPUT) if $^O eq 'MSWin32';
972
1082
 
973
1083
    while (<INPUT>) 
974
1084
    {
1012
1122
    }
1013
1123
 
1014
1124
    open OUTPUT, ">$OUTFILE" or die;
 
1125
    binmode (OUTPUT) if $^O eq 'MSWin32';
1015
1126
 
1016
1127
    # FIXME: support attribute translations
1017
1128
 
1113
1224
    }
1114
1225
 
1115
1226
    open OUTPUT, ">${OUTFILE}" or die;
 
1227
    binmode (OUTPUT) if $^O eq 'MSWin32';
1116
1228
 
1117
1229
    while ($source =~ /(^|\n+)(_*)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg)
1118
1230
    {
1253
1365
    return @list;
1254
1366
}
1255
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 ( ! -e $lang ) {
 
1390
            mkdir $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
}