« back to all changes in this revision
Viewing changes to intltool-merge.in
- browse files at revision 38
- compare with another revision
- download diff
- download tarball
- view history from revision 38
- Committer: Bazaar Package Importer
- Author(s): Josselin Mouette
- Date: 2009-09-26 01:14:29 UTC
- mfrom: (1.1.26 upstream) (3.1.4 sid)
- Revision ID: james.westby@ubuntu.com-20090926011429-11khy727w5dwny5w
Tags: 2.24.2-1
* Build-depend on libglib2.0-doc to ensure proper xrefs.
* New upstream translation release.
* New upstream translation release.
- files added:
- po/br.po
- files removed:
- INSTALL
- files modified:
- Makefile.in
added
removed
intltool-merge.in
1
#!@INTLTOOL_PERL@ -w
2
# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4 -*-
3
4
#
5
# The Intltool Message Merger
6
#
7
# Copyright (C) 2000, 2003 Free Software Foundation.
8
# Copyright (C) 2000, 2001 Eazel, Inc
9
#
10
# Intltool is free software; you can redistribute it and/or
11
# modify it under the terms of the GNU General Public License
12
# version 2 published by the Free Software Foundation.
13
#
14
# Intltool is distributed in the hope that it will be useful,
15
# but WITHOUT ANY WARRANTY; without even the implied warranty of
16
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17
# General Public License for more details.
18
#
19
# You should have received a copy of the GNU General Public License
20
# along with this program; if not, write to the Free Software
21
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
22
#
23
# As a special exception to the GNU General Public License, if you
24
# distribute this file as part of a program that contains a
25
# configuration script generated by Autoconf, you may include it under
26
# the same distribution terms that you use for the rest of that program.
27
#
28
# Authors: Maciej Stachowiak <mjs@noisehavoc.org>
29
# Kenneth Christiansen <kenneth@gnu.org>
30
# Darin Adler <darin@bentspoon.com>
31
#
32
# Proper XML UTF-8'ification written by Cyrille Chepelov <chepelov@calixo.net>
33
#
34
35
## Release information
36
my $PROGRAM = "intltool-merge";
37
my $PACKAGE = "intltool";
38
my $VERSION = "0.37.1";
39
40
## Loaded modules
41
use strict;
42
use Getopt::Long;
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 = "";
53
54
## Scalars used by the option stuff
55
my $HELP_ARG = 0;
56
my $VERSION_ARG = 0;
57
my $BA_STYLE_ARG = 0;
58
my $XML_STYLE_ARG = 0;
59
my $KEYS_STYLE_ARG = 0;
60
my $DESKTOP_STYLE_ARG = 0;
61
my $SCHEMAS_STYLE_ARG = 0;
62
my $RFC822DEB_STYLE_ARG = 0;
63
my $QUOTED_STYLE_ARG = 0;
64
my $QUOTEDXML_STYLE_ARG = 0;
65
my $QUIET_ARG = 0;
66
my $PASS_THROUGH_ARG = 0;
67
my $UTF8_ARG = 0;
68
my $MULTIPLE_OUTPUT = 0;
69
my $cache_file;
70
71
## Handle options
72
GetOptions
73
(
74
"help" => \$HELP_ARG,
75
"version" => \$VERSION_ARG,
76
"quiet|q" => \$QUIET_ARG,
77
"oaf-style|o" => \$BA_STYLE_ARG, ## for compatibility
78
"ba-style|b" => \$BA_STYLE_ARG,
79
"xml-style|x" => \$XML_STYLE_ARG,
80
"keys-style|k" => \$KEYS_STYLE_ARG,
81
"desktop-style|d" => \$DESKTOP_STYLE_ARG,
82
"schemas-style|s" => \$SCHEMAS_STYLE_ARG,
83
"rfc822deb-style|r" => \$RFC822DEB_STYLE_ARG,
84
"quoted-style" => \$QUOTED_STYLE_ARG,
85
"quotedxml-style" => \$QUOTEDXML_STYLE_ARG,
86
"pass-through|p" => \$PASS_THROUGH_ARG,
87
"utf8|u" => \$UTF8_ARG,
88
"multiple-output|m" => \$MULTIPLE_OUTPUT,
89
"cache|c=s" => \$cache_file
90
) or &error;
91
92
my $PO_DIR;
93
my $FILE;
94
my $OUTFILE;
95
96
my %po_files_by_lang = ();
97
my %translations = ();
98
my $iconv = $ENV{"ICONV"} || "iconv";
99
my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null');
100
101
sub isProgramInPath
102
{
103
my ($file) = @_;
104
# If either a file exists, or when run it returns 0 exit status
105
return 1 if ((-x $file) or (system("$file -l >$devnull") == 0));
106
return 0;
107
}
108
109
if (! isProgramInPath ("$iconv"))
110
{
111
print STDERR " *** iconv is not found on this system!\n".
112
" *** Without it, intltool-merge can not convert encodings.\n";
113
exit;
114
}
115
116
# Use this instead of \w for XML files to handle more possible characters.
117
my $w = "[-A-Za-z0-9._:]";
118
119
# XML quoted string contents
120
my $q = "[^\\\"]*";
121
122
## Check for options.
123
124
if ($VERSION_ARG)
125
{
126
&print_version;
127
}
128
elsif ($HELP_ARG)
129
{
130
&print_help;
131
}
132
elsif ($BA_STYLE_ARG && @ARGV > 2)
133
{
134
&utf8_sanity_check;
135
&preparation;
136
&print_message;
137
&ba_merge_translations;
138
&finalize;
139
}
140
elsif ($XML_STYLE_ARG && @ARGV > 2)
141
{
142
&utf8_sanity_check;
143
&preparation;
144
&print_message;
145
&xml_merge_output;
146
&finalize;
147
}
148
elsif ($KEYS_STYLE_ARG && @ARGV > 2)
149
{
150
&utf8_sanity_check;
151
&preparation;
152
&print_message;
153
&keys_merge_translations;
154
&finalize;
155
}
156
elsif ($DESKTOP_STYLE_ARG && @ARGV > 2)
157
{
158
&utf8_sanity_check;
159
&preparation;
160
&print_message;
161
&desktop_merge_translations;
162
&finalize;
163
}
164
elsif ($SCHEMAS_STYLE_ARG && @ARGV > 2)
165
{
166
&utf8_sanity_check;
167
&preparation;
168
&print_message;
169
&schemas_merge_translations;
170
&finalize;
171
}
172
elsif ($RFC822DEB_STYLE_ARG && @ARGV > 2)
173
{
174
&preparation;
175
&print_message;
176
&rfc822deb_merge_translations;
177
&finalize;
178
}
179
elsif (($QUOTED_STYLE_ARG || $QUOTEDXML_STYLE_ARG) && @ARGV > 2)
180
{
181
&utf8_sanity_check;
182
&preparation;
183
&print_message;
184
"ed_merge_translations($QUOTEDXML_STYLE_ARG);
185
&finalize;
186
}
187
else
188
{
189
&print_help;
190
}
191
192
exit;
193
194
## Sub for printing release information
195
sub print_version
196
{
197
print <<_EOF_;
198
${PROGRAM} (${PACKAGE}) ${VERSION}
199
Written by Maciej Stachowiak, Darin Adler and Kenneth Christiansen.
200
201
Copyright (C) 2000-2003 Free Software Foundation, Inc.
202
Copyright (C) 2000-2001 Eazel, Inc.
203
This is free software; see the source for copying conditions. There is NO
204
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
205
_EOF_
206
exit;
207
}
208
209
## Sub for printing usage information
210
sub print_help
211
{
212
print <<_EOF_;
213
Usage: ${PROGRAM} [OPTION]... PO_DIRECTORY FILENAME OUTPUT_FILE
214
Generates an output file that includes some localized attributes from an
215
untranslated source file.
216
217
Mandatory options: (exactly one must be specified)
218
-b, --ba-style includes translations in the bonobo-activation style
219
-d, --desktop-style includes translations in the desktop style
220
-k, --keys-style includes translations in the keys style
221
-s, --schemas-style includes translations in the schemas style
222
-r, --rfc822deb-style includes translations in the RFC822 style
223
--quoted-style includes translations in the quoted string style
224
--quotedxml-style includes translations in the quoted xml string style
225
-x, --xml-style includes translations in the standard xml style
226
227
Other options:
228
-u, --utf8 convert all strings to UTF-8 before merging
229
(default for everything except RFC822 style)
230
-p, --pass-through deprecated, does nothing and issues a warning
231
-m, --multiple-output output one localized file per locale, instead of
232
a single file containing all localized elements
233
-c, --cache=FILE specify cache file name
234
(usually \$top_builddir/po/.intltool-merge-cache)
235
-q, --quiet suppress most messages
236
--help display this help and exit
237
--version output version information and exit
238
239
Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE")
240
or send email to <xml-i18n-tools\@gnome.org>.
241
_EOF_
242
exit;
243
}
244
245
246
## Sub for printing error messages
247
sub print_error
248
{
249
print STDERR "Try `${PROGRAM} --help' for more information.\n";
250
exit;
251
}
252
253
254
sub print_message
255
{
256
print "Merging translations into $OUTFILE.\n" unless $QUIET_ARG;
257
}
258
259
260
sub preparation
261
{
262
$PO_DIR = $ARGV[0];
263
$FILE = $ARGV[1];
264
$OUTFILE = $ARGV[2];
265
266
&gather_po_files;
267
&get_translation_database;
268
}
269
270
# General-purpose code for looking up translations in .po files
271
272
sub po_file2lang
273
{
274
my ($tmp) = @_;
275
$tmp =~ s/^.*\/(.*)\.po$/$1/;
276
return $tmp;
277
}
278
279
sub gather_po_files
280
{
281
if (my $linguas = $ENV{"LINGUAS"})
282
{
283
for my $lang (split / /, $linguas) {
284
my $po_file = $PO_DIR . "/" . $lang . ".po";
285
if (-e $po_file) {
286
$po_files_by_lang{$lang} = $po_file;
287
}
288
}
289
}
290
else
291
{
292
if (open LINGUAS_FILE, "$PO_DIR/LINGUAS")
293
{
294
while (<LINGUAS_FILE>)
295
{
296
next if /^#/;
297
298
for my $lang (split)
299
{
300
chomp ($lang);
301
my $po_file = $PO_DIR . "/" . $lang . ".po";
302
if (-e $po_file) {
303
$po_files_by_lang{$lang} = $po_file;
304
}
305
}
306
}
307
308
close LINGUAS_FILE;
309
}
310
else
311
{
312
for my $po_file (glob "$PO_DIR/*.po") {
313
$po_files_by_lang{po_file2lang($po_file)} = $po_file;
314
}
315
}
316
}
317
}
318
319
sub get_local_charset
320
{
321
my ($encoding) = @_;
322
my $alias_file = $ENV{"G_CHARSET_ALIAS"} || "@INTLTOOL_LIBDIR@/charset.alias";
323
324
# seek character encoding aliases in charset.alias (glib)
325
326
if (open CHARSET_ALIAS, $alias_file)
327
{
328
while (<CHARSET_ALIAS>)
329
{
330
next if /^\#/;
331
return $1 if (/^\s*([-._a-zA-Z0-9]+)\s+$encoding\b/i)
332
}
333
334
close CHARSET_ALIAS;
335
}
336
337
# if not found, return input string
338
339
return $encoding;
340
}
341
342
sub get_po_encoding
343
{
344
my ($in_po_file) = @_;
345
my $encoding = "";
346
347
open IN_PO_FILE, $in_po_file or die;
348
while (<IN_PO_FILE>)
349
{
350
## example: "Content-Type: text/plain; charset=ISO-8859-1\n"
351
if (/Content-Type\:.*charset=([-a-zA-Z0-9]+)\\n/)
352
{
353
$encoding = $1;
354
last;
355
}
356
}
357
close IN_PO_FILE;
358
359
if (!$encoding)
360
{
361
print STDERR "Warning: no encoding found in $in_po_file. Assuming ISO-8859-1\n" unless $QUIET_ARG;
362
$encoding = "ISO-8859-1";
363
}
364
365
system ("$iconv -f $encoding -t UTF-8 <$devnull 2>$devnull");
366
if ($?) {
367
$encoding = get_local_charset($encoding);
368
}
369
370
return $encoding
371
}
372
373
sub utf8_sanity_check
374
{
375
print STDERR "Warning: option --pass-through has been removed.\n" if $PASS_THROUGH_ARG;
376
$UTF8_ARG = 1;
377
}
378
379
sub get_translation_database
380
{
381
if ($cache_file) {
382
&get_cached_translation_database;
383
} else {
384
&create_translation_database;
385
}
386
}
387
388
sub get_newest_po_age
389
{
390
my $newest_age;
391
392
foreach my $file (values %po_files_by_lang)
393
{
394
my $file_age = -M $file;
395
$newest_age = $file_age if !$newest_age || $file_age < $newest_age;
396
}
397
398
$newest_age = 0 if !$newest_age;
399
400
return $newest_age;
401
}
402
403
sub create_cache
404
{
405
print "Generating and caching the translation database\n" unless $QUIET_ARG;
406
407
&create_translation_database;
408
409
open CACHE, ">$cache_file" || die;
410
print CACHE join "\x01", %translations;
411
close CACHE;
412
}
413
414
sub load_cache
415
{
416
print "Found cached translation database\n" unless $QUIET_ARG;
417
418
my $contents;
419
open CACHE, "<$cache_file" || die;
420
{
421
local $/;
422
$contents = <CACHE>;
423
}
424
close CACHE;
425
%translations = split "\x01", $contents;
426
}
427
428
sub get_cached_translation_database
429
{
430
my $cache_file_age = -M $cache_file;
431
if (defined $cache_file_age)
432
{
433
if ($cache_file_age <= &get_newest_po_age)
434
{
435
&load_cache;
436
return;
437
}
438
print "Found too-old cached translation database\n" unless $QUIET_ARG;
439
}
440
441
&create_cache;
442
}
443
444
sub create_translation_database
445
{
446
for my $lang (keys %po_files_by_lang)
447
{
448
my $po_file = $po_files_by_lang{$lang};
449
450
if ($UTF8_ARG)
451
{
452
my $encoding = get_po_encoding ($po_file);
453
454
if (lc $encoding eq "utf-8")
455
{
456
open PO_FILE, "<$po_file";
457
}
458
else
459
{
460
print "NOTICE: $po_file is not in UTF-8 but $encoding, converting...\n" unless $QUIET_ARG;;
461
462
open PO_FILE, "$iconv -f $encoding -t UTF-8 $po_file|";
463
}
464
}
465
else
466
{
467
open PO_FILE, "<$po_file";
468
}
469
470
my $nextfuzzy = 0;
471
my $inmsgid = 0;
472
my $inmsgstr = 0;
473
my $msgid = "";
474
my $msgstr = "";
475
476
while (<PO_FILE>)
477
{
478
$nextfuzzy = 1 if /^#, fuzzy/;
479
480
if (/^msgid "((\\.|[^\\]+)*)"/ )
481
{
482
$translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr;
483
$msgid = "";
484
$msgstr = "";
485
486
if ($nextfuzzy) {
487
$inmsgid = 0;
488
} else {
489
$msgid = unescape_po_string($1);
490
$inmsgid = 1;
491
}
492
$inmsgstr = 0;
493
$nextfuzzy = 0;
494
}
495
496
if (/^msgstr "((\\.|[^\\]+)*)"/)
497
{
498
$msgstr = unescape_po_string($1);
499
$inmsgstr = 1;
500
$inmsgid = 0;
501
}
502
503
if (/^"((\\.|[^\\]+)*)"/)
504
{
505
$msgid .= unescape_po_string($1) if $inmsgid;
506
$msgstr .= unescape_po_string($1) if $inmsgstr;
507
}
508
}
509
$translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr;
510
}
511
}
512
513
sub finalize
514
{
515
}
516
517
sub unescape_one_sequence
518
{
519
my ($sequence) = @_;
520
521
return "\\" if $sequence eq "\\\\";
522
return "\"" if $sequence eq "\\\"";
523
return "\n" if $sequence eq "\\n";
524
return "\r" if $sequence eq "\\r";
525
return "\t" if $sequence eq "\\t";
526
return "\b" if $sequence eq "\\b";
527
return "\f" if $sequence eq "\\f";
528
return "\a" if $sequence eq "\\a";
529
return chr(11) if $sequence eq "\\v"; # vertical tab, see ascii(7)
530
531
return chr(hex($1)) if ($sequence =~ /\\x([0-9a-fA-F]{2})/);
532
return chr(oct($1)) if ($sequence =~ /\\([0-7]{3})/);
533
534
# FIXME: Is \0 supported as well? Kenneth and Rodney don't want it, see bug #48489
535
536
return $sequence;
537
}
538
539
sub unescape_po_string
540
{
541
my ($string) = @_;
542
543
$string =~ s/(\\x[0-9a-fA-F]{2}|\\[0-7]{3}|\\.)/unescape_one_sequence($1)/eg;
544
545
return $string;
546
}
547
548
sub entity_decode
549
{
550
local ($_) = @_;
551
552
s/'/'/g; # '
553
s/"/"/g; # "
554
s/</</g;
555
s/>/>/g;
556
s/&/&/g;
557
558
return $_;
559
}
560
561
# entity_encode: (string)
562
#
563
# Encode the given string to XML format (encode '<' etc).
564
565
sub entity_encode
566
{
567
my ($pre_encoded) = @_;
568
569
my @list_of_chars = unpack ('C*', $pre_encoded);
570
571
# with UTF-8 we only encode minimalistic
572
return join ('', map (&entity_encode_int_minimalist, @list_of_chars));
573
}
574
575
sub entity_encode_int_minimalist
576
{
577
return """ if $_ == 34;
578
return "&" if $_ == 38;
579
return "'" if $_ == 39;
580
return "<" if $_ == 60;
581
return ">" if $_ == 62;
582
return chr $_;
583
}
584
585
sub entity_encoded_translation
586
{
587
my ($lang, $string) = @_;
588
589
my $translation = $translations{$lang, $string};
590
return $string if !$translation;
591
return entity_encode ($translation);
592
}
593
594
## XML (bonobo-activation specific) merge code
595
596
sub ba_merge_translations
597
{
598
my $source;
599
600
{
601
local $/; # slurp mode
602
open INPUT, "<$FILE" or die "can't open $FILE: $!";
603
$source = <INPUT>;
604
close INPUT;
605
}
606
607
open OUTPUT, ">$OUTFILE" or die "can't open $OUTFILE: $!";
608
# Binmode so that selftest works ok if using a native Win32 Perl...
609
binmode (OUTPUT) if $^O eq 'MSWin32';
610
611
while ($source =~ s|^(.*?)([ \t]*<\s*$w+\s+($w+\s*=\s*"$q"\s*)+/?>)([ \t]*\n)?||s)
612
{
613
print OUTPUT $1;
614
615
my $node = $2 . "\n";
616
617
my @strings = ();
618
$_ = $node;
619
while (s/(\s)_($w+\s*=\s*"($q)")/$1$2/s) {
620
push @strings, entity_decode($3);
621
}
622
print OUTPUT;
623
624
my %langs;
625
for my $string (@strings)
626
{
627
for my $lang (keys %po_files_by_lang)
628
{
629
$langs{$lang} = 1 if $translations{$lang, $string};
630
}
631
}
632
633
for my $lang (sort keys %langs)
634
{
635
$_ = $node;
636
s/(\sname\s*=\s*)"($q)"/$1"$2-$lang"/s;
637
s/(\s)_($w+\s*=\s*")($q)"/$1 . $2 . entity_encoded_translation($lang, $3) . '"'/seg;
638
print OUTPUT;
639
}
640
}
641
642
print OUTPUT $source;
643
644
close OUTPUT;
645
}
646
647
648
## XML (non-bonobo-activation) merge code
649
650
651
# Process tag attributes
652
# Only parameter is a HASH containing attributes -> values mapping
653
sub getAttributeString
654
{
655
my $sub = shift;
656
my $do_translate = shift || 0;
657
my $language = shift || "";
658
my $result = "";
659
my $translate = shift;
660
foreach my $e (reverse(sort(keys %{ $sub }))) {
661
my $key = $e;
662
my $string = $sub->{$e};
663
my $quote = '"';
664
665
$string =~ s/^[\s]+//;
666
$string =~ s/[\s]+$//;
667
668
if ($string =~ /^'.*'$/)
669
{
670
$quote = "'";
671
}
672
$string =~ s/^['"]//g;
673
$string =~ s/['"]$//g;
674
675
if ($do_translate && $key =~ /^_/) {
676
$key =~ s|^_||g;
677
if ($language) {
678
# Handle translation
679
my $decode_string = entity_decode($string);
680
my $translation = $translations{$language, $decode_string};
681
if ($translation) {
682
$translation = entity_encode($translation);
683
$string = $translation;
684
}
685
$$translate = 2;
686
} else {
687
$$translate = 2 if ($translate && (!$$translate)); # watch not to "overwrite" $translate
688
}
689
}
690
691
$result .= " $key=$quote$string$quote";
692
}
693
return $result;
694
}
695
696
# Returns a translatable string from XML node, it works on contents of every node in XML::Parser tree
697
sub getXMLstring
698
{
699
my $ref = shift;
700
my $spacepreserve = shift || 0;
701
my @list = @{ $ref };
702
my $result = "";
703
704
my $count = scalar(@list);
705
my $attrs = $list[0];
706
my $index = 1;
707
708
$spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
709
$spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
710
711
while ($index < $count) {
712
my $type = $list[$index];
713
my $content = $list[$index+1];
714
if (! $type ) {
715
# We've got CDATA
716
if ($content) {
717
# lets strip the whitespace here, and *ONLY* here
718
$content =~ s/\s+/ /gs if (!$spacepreserve);
719
$result .= $content;
720
}
721
} elsif ( "$type" ne "1" ) {
722
# We've got another element
723
$result .= "<$type";
724
$result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements
725
if ($content) {
726
my $subresult = getXMLstring($content, $spacepreserve);
727
if ($subresult) {
728
$result .= ">".$subresult . "</$type>";
729
} else {
730
$result .= "/>";
731
}
732
} else {
733
$result .= "/>";
734
}
735
}
736
$index += 2;
737
}
738
return $result;
739
}
740
741
# Translate list of nodes if necessary
742
sub translate_subnodes
743
{
744
my $fh = shift;
745
my $content = shift;
746
my $language = shift || "";
747
my $singlelang = shift || 0;
748
my $spacepreserve = shift || 0;
749
750
my @nodes = @{ $content };
751
752
my $count = scalar(@nodes);
753
my $index = 0;
754
while ($index < $count) {
755
my $type = $nodes[$index];
756
my $rest = $nodes[$index+1];
757
if ($singlelang) {
758
my $oldMO = $MULTIPLE_OUTPUT;
759
$MULTIPLE_OUTPUT = 1;
760
traverse($fh, $type, $rest, $language, $spacepreserve);
761
$MULTIPLE_OUTPUT = $oldMO;
762
} else {
763
traverse($fh, $type, $rest, $language, $spacepreserve);
764
}
765
$index += 2;
766
}
767
}
768
769
sub isWellFormedXmlFragment
770
{
771
my $ret = eval 'require XML::Parser';
772
if(!$ret) {
773
die "You must have XML::Parser installed to run $0\n\n";
774
}
775
776
my $fragment = shift;
777
return 0 if (!$fragment);
778
779
$fragment = "<root>$fragment</root>";
780
my $xp = new XML::Parser(Style => 'Tree');
781
my $tree = 0;
782
eval { $tree = $xp->parse($fragment); };
783
return $tree;
784
}
785
786
sub traverse
787
{
788
my $fh = shift;
789
my $nodename = shift;
790
my $content = shift;
791
my $language = shift || "";
792
my $spacepreserve = shift || 0;
793
794
if (!$nodename) {
795
if ($content =~ /^[\s]*$/) {
796
$leading_space .= $content;
797
}
798
print $fh $content;
799
} else {
800
# element
801
my @all = @{ $content };
802
my $attrs = shift @all;
803
my $translate = 0;
804
my $outattr = getAttributeString($attrs, 1, $language, \$translate);
805
806
if ($nodename =~ /^_/) {
807
$translate = 1;
808
$nodename =~ s/^_//;
809
}
810
my $lookup = '';
811
812
$spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
813
$spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
814
815
print $fh "<$nodename", $outattr;
816
if ($translate) {
817
$lookup = getXMLstring($content, $spacepreserve);
818
if (!$spacepreserve) {
819
$lookup =~ s/^\s+//s;
820
$lookup =~ s/\s+$//s;
821
}
822
823
if ($lookup || $translate == 2) {
824
my $translation = $translations{$language, $lookup} if isWellFormedXmlFragment($translations{$language, $lookup});
825
if ($MULTIPLE_OUTPUT && ($translation || $translate == 2)) {
826
$translation = $lookup if (!$translation);
827
print $fh " xml:lang=\"", $language, "\"" if $language;
828
print $fh ">";
829
if ($translate == 2) {
830
translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
831
} else {
832
print $fh $translation;
833
}
834
print $fh "</$nodename>";
835
836
return; # this means there will be no same translation with xml:lang="$language"...
837
# if we want them both, just remove this "return"
838
} else {
839
print $fh ">";
840
if ($translate == 2) {
841
translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
842
} else {
843
print $fh $lookup;
844
}
845
print $fh "</$nodename>";
846
}
847
} else {
848
print $fh "/>";
849
}
850
851
for my $lang (sort keys %po_files_by_lang) {
852
if ($MULTIPLE_OUTPUT && $lang ne "$language") {
853
next;
854
}
855
if ($lang) {
856
# Handle translation
857
#
858
my $translate = 0;
859
my $localattrs = getAttributeString($attrs, 1, $lang, \$translate);
860
my $translation = $translations{$lang, $lookup} if isWellFormedXmlFragment($translations{$lang, $lookup});
861
if ($translate && !$translation) {
862
$translation = $lookup;
863
}
864
865
if ($translation || $translate) {
866
print $fh "\n";
867
$leading_space =~ s/.*\n//g;
868
print $fh $leading_space;
869
print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs, ">";
870
if ($translate == 2) {
871
translate_subnodes($fh, \@all, $lang, 1, $spacepreserve);
872
} else {
873
print $fh $translation;
874
}
875
print $fh "</$nodename>";
876
}
877
}
878
}
879
880
} else {
881
my $count = scalar(@all);
882
if ($count > 0) {
883
print $fh ">";
884
my $index = 0;
885
while ($index < $count) {
886
my $type = $all[$index];
887
my $rest = $all[$index+1];
888
traverse($fh, $type, $rest, $language, $spacepreserve);
889
$index += 2;
890
}
891
print $fh "</$nodename>";
892
} else {
893
print $fh "/>";
894
}
895
}
896
}
897
}
898
899
sub intltool_tree_comment
900
{
901
my $expat = shift;
902
my $data = shift;
903
my $clist = $expat->{Curlist};
904
my $pos = $#$clist;
905
906
push @$clist, 1 => $data;
907
}
908
909
sub intltool_tree_cdatastart
910
{
911
my $expat = shift;
912
my $clist = $expat->{Curlist};
913
my $pos = $#$clist;
914
915
push @$clist, 0 => $expat->original_string();
916
}
917
918
sub intltool_tree_cdataend
919
{
920
my $expat = shift;
921
my $clist = $expat->{Curlist};
922
my $pos = $#$clist;
923
924
$clist->[$pos] .= $expat->original_string();
925
}
926
927
sub intltool_tree_char
928
{
929
my $expat = shift;
930
my $text = shift;
931
my $clist = $expat->{Curlist};
932
my $pos = $#$clist;
933
934
# Use original_string so that we retain escaped entities
935
# in CDATA sections.
936
#
937
if ($pos > 0 and $clist->[$pos - 1] eq '0') {
938
$clist->[$pos] .= $expat->original_string();
939
} else {
940
push @$clist, 0 => $expat->original_string();
941
}
942
}
943
944
sub intltool_tree_start
945
{
946
my $expat = shift;
947
my $tag = shift;
948
my @origlist = ();
949
950
# Use original_string so that we retain escaped entities
951
# in attribute values. We must convert the string to an
952
# @origlist array to conform to the structure of the Tree
953
# Style.
954
#
955
my @original_array = split /\x/, $expat->original_string();
956
my $source = $expat->original_string();
957
958
# Remove leading tag.
959
#
960
$source =~ s|^\s*<\s*(\S+)||s;
961
962
# Grab attribute key/value pairs and push onto @origlist array.
963
#
964
while ($source)
965
{
966
if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/)
967
{
968
$source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s;
969
push @origlist, $1;
970
push @origlist, '"' . $2 . '"';
971
}
972
elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/)
973
{
974
$source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s;
975
push @origlist, $1;
976
push @origlist, "'" . $2 . "'";
977
}
978
else
979
{
980
last;
981
}
982
}
983
984
my $ol = [ { @origlist } ];
985
986
push @{ $expat->{Lists} }, $expat->{Curlist};
987
push @{ $expat->{Curlist} }, $tag => $ol;
988
$expat->{Curlist} = $ol;
989
}
990
991
sub readXml
992
{
993
my $filename = shift || return;
994
if(!-f $filename) {
995
die "ERROR Cannot find filename: $filename\n";
996
}
997
998
my $ret = eval 'require XML::Parser';
999
if(!$ret) {
1000
die "You must have XML::Parser installed to run $0\n\n";
1001
}
1002
my $xp = new XML::Parser(Style => 'Tree');
1003
$xp->setHandlers(Char => \&intltool_tree_char);
1004
$xp->setHandlers(Start => \&intltool_tree_start);
1005
$xp->setHandlers(CdataStart => \&intltool_tree_cdatastart);
1006
$xp->setHandlers(CdataEnd => \&intltool_tree_cdataend);
1007
my $tree = $xp->parsefile($filename);
1008
1009
# <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
1010
# would be:
1011
# [foo, [{}, head, [{id => "a"}, 0, "Hello ", em, [{}, 0, "there"]], bar, [{},
1012
# 0, "Howdy", ref, [{}]], 0, "do" ] ]
1013
1014
return $tree;
1015
}
1016
1017
sub print_header
1018
{
1019
my $infile = shift;
1020
my $fh = shift;
1021
my $source;
1022
1023
if(!-f $infile) {
1024
die "ERROR Cannot find filename: $infile\n";
1025
}
1026
1027
print $fh qq{<?xml version="1.0" encoding="UTF-8"?>\n};
1028
{
1029
local $/;
1030
open DOCINPUT, "<${FILE}" or die;
1031
$source = <DOCINPUT>;
1032
close DOCINPUT;
1033
}
1034
if ($source =~ /(<!DOCTYPE.*\[.*\]\s*>)/s)
1035
{
1036
print $fh "$1\n";
1037
}
1038
elsif ($source =~ /(<!DOCTYPE[^>]*>)/s)
1039
{
1040
print $fh "$1\n";
1041
}
1042
}
1043
1044
sub parseTree
1045
{
1046
my $fh = shift;
1047
my $ref = shift;
1048
my $language = shift || "";
1049
1050
my $name = shift @{ $ref };
1051
my $cont = shift @{ $ref };
1052
1053
while (!$name || "$name" eq "1") {
1054
$name = shift @{ $ref };
1055
$cont = shift @{ $ref };
1056
}
1057
1058
my $spacepreserve = 0;
1059
my $attrs = @{$cont}[0];
1060
$spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
1061
1062
traverse($fh, $name, $cont, $language, $spacepreserve);
1063
}
1064
1065
sub xml_merge_output
1066
{
1067
my $source;
1068
1069
if ($MULTIPLE_OUTPUT) {
1070
for my $lang (sort keys %po_files_by_lang) {
1071
if ( ! -d $lang ) {
1072
mkdir $lang or -d $lang or die "Cannot create subdirectory $lang: $!\n";
1073
}
1074
open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
1075
binmode (OUTPUT) if $^O eq 'MSWin32';
1076
my $tree = readXml($FILE);
1077
print_header($FILE, \*OUTPUT);
1078
parseTree(\*OUTPUT, $tree, $lang);
1079
close OUTPUT;
1080
print "CREATED $lang/$OUTFILE\n" unless $QUIET_ARG;
1081
}
1082
if ( ! -d "C" ) {
1083
mkdir "C" or -d "C" or die "Cannot create subdirectory C: $!\n";
1084
}
1085
open OUTPUT, ">C/$OUTFILE" or die "Cannot open C/$OUTFILE: $!\n";
1086
binmode (OUTPUT) if $^O eq 'MSWin32';
1087
my $tree = readXml($FILE);
1088
print_header($FILE, \*OUTPUT);
1089
parseTree(\*OUTPUT, $tree);
1090
close OUTPUT;
1091
print "CREATED C/$OUTFILE\n" unless $QUIET_ARG;
1092
} else {
1093
open OUTPUT, ">$OUTFILE" or die "Cannot open $OUTFILE: $!\n";
1094
binmode (OUTPUT) if $^O eq 'MSWin32';
1095
my $tree = readXml($FILE);
1096
print_header($FILE, \*OUTPUT);
1097
parseTree(\*OUTPUT, $tree);
1098
close OUTPUT;
1099
print "CREATED $OUTFILE\n" unless $QUIET_ARG;
1100
}
1101
}
1102
1103
sub keys_merge_translation
1104
{
1105
my ($lang) = @_;
1106
1107
if ( ! -d $lang && $MULTIPLE_OUTPUT)
1108
{
1109
mkdir $lang or -d $lang or die "Cannot create subdirectory $lang: $!\n";
1110
}
1111
1112
open INPUT, "<${FILE}" or die "Cannot open ${FILE}: $!\n";
1113
open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
1114
binmode (OUTPUT) if $^O eq 'MSWin32';
1115
1116
while (<INPUT>)
1117
{
1118
if (s/^(\s*)_(\w+=(.*))/$1$2/)
1119
{
1120
my $string = $3;
1121
1122
if (!$MULTIPLE_OUTPUT)
1123
{
1124
print OUTPUT;
1125
1126
my $non_translated_line = $_;
1127
1128
for my $lang (sort keys %po_files_by_lang)
1129
{
1130
my $translation = $translations{$lang, $string};
1131
next if !$translation;
1132
1133
$_ = $non_translated_line;
1134
s/(\w+)=.*/[$lang]$1=$translation/;
1135
print OUTPUT;
1136
}
1137
}
1138
else
1139
{
1140
my $non_translated_line = $_;
1141
my $translation = $translations{$lang, $string};
1142
$translation = $string if !$translation;
1143
1144
$_ = $non_translated_line;
1145
s/(\w+)=.*/$1=$translation/;
1146
print OUTPUT;
1147
}
1148
}
1149
else
1150
{
1151
print OUTPUT;
1152
}
1153
}
1154
1155
close OUTPUT;
1156
close INPUT;
1157
1158
print "CREATED $lang/$OUTFILE\n" unless $QUIET_ARG;
1159
}
1160
1161
sub keys_merge_translations
1162
{
1163
if ($MULTIPLE_OUTPUT)
1164
{
1165
for my $lang (sort keys %po_files_by_lang)
1166
{
1167
keys_merge_translation ($lang);
1168
}
1169
keys_merge_translation ("C");
1170
}
1171
else
1172
{
1173
keys_merge_translation (".");
1174
}
1175
}
1176
1177
sub desktop_merge_translations
1178
{
1179
open INPUT, "<${FILE}" or die;
1180
open OUTPUT, ">${OUTFILE}" or die;
1181
binmode (OUTPUT) if $^O eq 'MSWin32';
1182
1183
while (<INPUT>)
1184
{
1185
if (s/^(\s*)_(\w+=(.*))/$1$2/)
1186
{
1187
my $string = $3;
1188
1189
print OUTPUT;
1190
1191
my $non_translated_line = $_;
1192
1193
for my $lang (sort keys %po_files_by_lang)
1194
{
1195
my $translation = $translations{$lang, $string};
1196
next if !$translation;
1197
1198
$_ = $non_translated_line;
1199
s/(\w+)=.*/${1}[$lang]=$translation/;
1200
print OUTPUT;
1201
}
1202
}
1203
else
1204
{
1205
print OUTPUT;
1206
}
1207
}
1208
1209
close OUTPUT;
1210
close INPUT;
1211
}
1212
1213
sub schemas_merge_translations
1214
{
1215
my $source;
1216
1217
{
1218
local $/; # slurp mode
1219
open INPUT, "<$FILE" or die "can't open $FILE: $!";
1220
$source = <INPUT>;
1221
close INPUT;
1222
}
1223
1224
open OUTPUT, ">$OUTFILE" or die;
1225
binmode (OUTPUT) if $^O eq 'MSWin32';
1226
1227
# FIXME: support attribute translations
1228
1229
# Empty nodes never need translation, so unmark all of them.
1230
# For example, <_foo/> is just replaced by <foo/>.
1231
$source =~ s|<\s*_($w+)\s*/>|<$1/>|g;
1232
1233
while ($source =~ s/
1234
(.*?)
1235
(\s+)(<locale\ name="C">(\s*)
1236
(<default>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/default>)?(\s*)
1237
(<short>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/short>)?(\s*)
1238
(<long>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/long>)?(\s*)
1239
<\/locale>)
1240
//sx)
1241
{
1242
print OUTPUT $1;
1243
1244
my $locale_start_spaces = $2 ? $2 : '';
1245
my $default_spaces = $4 ? $4 : '';
1246
my $short_spaces = $7 ? $7 : '';
1247
my $long_spaces = $10 ? $10 : '';
1248
my $locale_end_spaces = $13 ? $13 : '';
1249
my $c_default_block = $3 ? $3 : '';
1250
my $default_string = $6 ? $6 : '';
1251
my $short_string = $9 ? $9 : '';
1252
my $long_string = $12 ? $12 : '';
1253
1254
print OUTPUT "$locale_start_spaces$c_default_block";
1255
1256
$default_string =~ s/\s+/ /g;
1257
$default_string = entity_decode($default_string);
1258
$short_string =~ s/\s+/ /g;
1259
$short_string = entity_decode($short_string);
1260
$long_string =~ s/\s+/ /g;
1261
$long_string = entity_decode($long_string);
1262
1263
for my $lang (sort keys %po_files_by_lang)
1264
{
1265
my $default_translation = $translations{$lang, $default_string};
1266
my $short_translation = $translations{$lang, $short_string};
1267
my $long_translation = $translations{$lang, $long_string};
1268
1269
next if (!$default_translation && !$short_translation &&
1270
!$long_translation);
1271
1272
print OUTPUT "\n$locale_start_spaces<locale name=\"$lang\">";
1273
1274
print OUTPUT "$default_spaces";
1275
1276
if ($default_translation)
1277
{
1278
$default_translation = entity_encode($default_translation);
1279
print OUTPUT "<default>$default_translation</default>";
1280
}
1281
1282
print OUTPUT "$short_spaces";
1283
1284
if ($short_translation)
1285
{
1286
$short_translation = entity_encode($short_translation);
1287
print OUTPUT "<short>$short_translation</short>";
1288
}
1289
1290
print OUTPUT "$long_spaces";
1291
1292
if ($long_translation)
1293
{
1294
$long_translation = entity_encode($long_translation);
1295
print OUTPUT "<long>$long_translation</long>";
1296
}
1297
1298
print OUTPUT "$locale_end_spaces</locale>";
1299
}
1300
}
1301
1302
print OUTPUT $source;
1303
1304
close OUTPUT;
1305
}
1306
1307
sub rfc822deb_merge_translations
1308
{
1309
my %encodings = ();
1310
for my $lang (keys %po_files_by_lang) {
1311
$encodings{$lang} = ($UTF8_ARG ? 'UTF-8' : get_po_encoding($po_files_by_lang{$lang}));
1312
}
1313
1314
my $source;
1315
1316
$Text::Wrap::huge = 'overflow';
1317
$Text::Wrap::break = qr/\n|\s(?=\S)/;
1318
1319
{
1320
local $/; # slurp mode
1321
open INPUT, "<$FILE" or die "can't open $FILE: $!";
1322
$source = <INPUT>;
1323
close INPUT;
1324
}
1325
1326
open OUTPUT, ">${OUTFILE}" or die;
1327
binmode (OUTPUT) if $^O eq 'MSWin32';
1328
1329
while ($source =~ /(^|\n+)(_*)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg)
1330
{
1331
my $sep = $1;
1332
my $non_translated_line = $3.$4;
1333
my $string = $5;
1334
my $underscore = length($2);
1335
next if $underscore eq 0 && $non_translated_line =~ /^#/;
1336
# Remove [] dummy strings
1337
my $stripped = $string;
1338
$stripped =~ s/\[\s[^\[\]]*\],/,/g if $underscore eq 2;
1339
$stripped =~ s/\[\s[^\[\]]*\]$//;
1340
$non_translated_line .= $stripped;
1341
1342
print OUTPUT $sep.$non_translated_line;
1343
1344
if ($underscore)
1345
{
1346
my @str_list = rfc822deb_split($underscore, $string);
1347
1348
for my $lang (sort keys %po_files_by_lang)
1349
{
1350
my $is_translated = 1;
1351
my $str_translated = '';
1352
my $first = 1;
1353
1354
for my $str (@str_list)
1355
{
1356
my $translation = $translations{$lang, $str};
1357
1358
if (!$translation)
1359
{
1360
$is_translated = 0;
1361
last;
1362
}
1363
1364
# $translation may also contain [] dummy
1365
# strings, mostly to indicate an empty string
1366
$translation =~ s/\[\s[^\[\]]*\]$//;
1367
1368
if ($first)
1369
{
1370
if ($underscore eq 2)
1371
{
1372
$str_translated .= $translation;
1373
}
1374
else
1375
{
1376
$str_translated .=
1377
Text::Tabs::expand($translation) .
1378
"\n";
1379
}
1380
}
1381
else
1382
{
1383
if ($underscore eq 2)
1384
{
1385
$str_translated .= ', ' . $translation;
1386
}
1387
else
1388
{
1389
$str_translated .= Text::Tabs::expand(
1390
Text::Wrap::wrap(' ', ' ', $translation)) .
1391
"\n .\n";
1392
}
1393
}
1394
$first = 0;
1395
1396
# To fix some problems with Text::Wrap::wrap
1397
$str_translated =~ s/(\n )+\n/\n .\n/g;
1398
}
1399
next unless $is_translated;
1400
1401
$str_translated =~ s/\n \.\n$//;
1402
$str_translated =~ s/\s+$//;
1403
1404
$_ = $non_translated_line;
1405
s/^(\w+):\s*.*/$sep${1}-$lang.$encodings{$lang}: $str_translated/s;
1406
print OUTPUT;
1407
}
1408
}
1409
}
1410
print OUTPUT "\n";
1411
1412
close OUTPUT;
1413
close INPUT;
1414
}
1415
1416
sub rfc822deb_split
1417
{
1418
# Debian defines a special way to deal with rfc822-style files:
1419
# when a value contain newlines, it consists of
1420
# 1. a short form (first line)
1421
# 2. a long description, all lines begin with a space,
1422
# and paragraphs are separated by a single dot on a line
1423
# This routine returns an array of all paragraphs, and reformat
1424
# them.
1425
# When first argument is 2, the string is a comma separated list of
1426
# values.
1427
my $type = shift;
1428
my $text = shift;
1429
$text =~ s/^[ \t]//mg;
1430
return (split(/, */, $text, 0)) if $type ne 1;
1431
return ($text) if $text !~ /\n/;
1432
1433
$text =~ s/([^\n]*)\n//;
1434
my @list = ($1);
1435
my $str = '';
1436
1437
for my $line (split (/\n/, $text))
1438
{
1439
chomp $line;
1440
if ($line =~ /^\.\s*$/)
1441
{
1442
# New paragraph
1443
$str =~ s/\s*$//;
1444
push(@list, $str);
1445
$str = '';
1446
}
1447
elsif ($line =~ /^\s/)
1448
{
1449
# Line which must not be reformatted
1450
$str .= "\n" if length ($str) && $str !~ /\n$/;
1451
$line =~ s/\s+$//;
1452
$str .= $line."\n";
1453
}
1454
else
1455
{
1456
# Continuation line, remove newline
1457
$str .= " " if length ($str) && $str !~ /\n$/;
1458
$str .= $line;
1459
}
1460
}
1461
1462
$str =~ s/\s*$//;
1463
push(@list, $str) if length ($str);
1464
1465
return @list;
1466
}
1467
1468
sub quoted_translation
1469
{
1470
my ($xml_mode, $lang, $string) = @_;
1471
1472
$string = entity_decode($string) if $xml_mode;
1473
$string =~ s/\\\"/\"/g;
1474
1475
my $translation = $translations{$lang, $string};
1476
$translation = $string if !$translation;
1477
$translation = entity_encode($translation) if $xml_mode;
1478
$translation =~ s/\"/\\\"/g;
1479
return $translation
1480
}
1481
1482
sub quoted_merge_translations
1483
{
1484
my ($xml_mode) = @_;
1485
1486
if (!$MULTIPLE_OUTPUT) {
1487
print "Quoted only supports Multiple Output.\n";
1488
exit(1);
1489
}
1490
1491
for my $lang (sort keys %po_files_by_lang) {
1492
if ( ! -d $lang ) {
1493
mkdir $lang or -d $lang or die "Cannot create subdirectory $lang: $!\n";
1494
}
1495
open INPUT, "<${FILE}" or die;
1496
open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
1497
binmode (OUTPUT) if $^O eq 'MSWin32';
1498
while (<INPUT>)
1499
{
1500
s/\"(([^\"]|\\\")*[^\\\"])\"/"\"" . "ed_translation($xml_mode, $lang, $1) . "\""/ge;
1501
print OUTPUT;
1502
}
1503
close OUTPUT;
1504
close INPUT;
1505
}
1506
}
Loggerhead is a web-based interface for Breezy
Version: 2.0.1