|
1
by Cesare Tirabassi
Import upstream version 1.2.0 |
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.35.5"; |
|
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 $QUIET_ARG = 0; |
|
65 |
my $PASS_THROUGH_ARG = 0; |
|
66 |
my $UTF8_ARG = 0; |
|
67 |
my $MULTIPLE_OUTPUT = 0; |
|
68 |
my $cache_file; |
|
69 |
||
70 |
## Handle options
|
|
71 |
GetOptions
|
|
72 |
(
|
|
73 |
"help" => \$HELP_ARG, |
|
74 |
"version" => \$VERSION_ARG, |
|
75 |
"quiet|q" => \$QUIET_ARG, |
|
76 |
"oaf-style|o" => \$BA_STYLE_ARG, ## for compatibility |
|
77 |
"ba-style|b" => \$BA_STYLE_ARG, |
|
78 |
"xml-style|x" => \$XML_STYLE_ARG, |
|
79 |
"keys-style|k" => \$KEYS_STYLE_ARG, |
|
80 |
"desktop-style|d" => \$DESKTOP_STYLE_ARG, |
|
81 |
"schemas-style|s" => \$SCHEMAS_STYLE_ARG, |
|
82 |
"rfc822deb-style|r" => \$RFC822DEB_STYLE_ARG, |
|
83 |
"quoted-style" => \$QUOTED_STYLE_ARG, |
|
84 |
"pass-through|p" => \$PASS_THROUGH_ARG, |
|
85 |
"utf8|u" => \$UTF8_ARG, |
|
86 |
"multiple-output|m" => \$MULTIPLE_OUTPUT, |
|
87 |
"cache|c=s" => \$cache_file |
|
88 |
) or &error; |
|
89 |
||
90 |
my $PO_DIR; |
|
91 |
my $FILE; |
|
92 |
my $OUTFILE; |
|
93 |
||
94 |
my %po_files_by_lang = (); |
|
95 |
my %translations = (); |
|
96 |
my $iconv = $ENV{"ICONV"} || $ENV{"INTLTOOL_ICONV"} || "@INTLTOOL_ICONV@"; |
|
97 |
my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null'); |
|
98 |
||
99 |
# Use this instead of \w for XML files to handle more possible characters.
|
|
100 |
my $w = "[-A-Za-z0-9._:]"; |
|
101 |
||
102 |
# XML quoted string contents
|
|
103 |
my $q = "[^\\\"]*"; |
|
104 |
||
105 |
## Check for options.
|
|
106 |
||
107 |
if ($VERSION_ARG) |
|
108 |
{
|
|
109 |
&print_version; |
|
110 |
}
|
|
111 |
elsif ($HELP_ARG) |
|
112 |
{
|
|
113 |
&print_help; |
|
114 |
}
|
|
115 |
elsif ($BA_STYLE_ARG && @ARGV > 2) |
|
116 |
{
|
|
117 |
&utf8_sanity_check; |
|
118 |
&preparation; |
|
119 |
&print_message; |
|
120 |
&ba_merge_translations; |
|
121 |
&finalize; |
|
122 |
}
|
|
123 |
elsif ($XML_STYLE_ARG && @ARGV > 2) |
|
124 |
{
|
|
125 |
&utf8_sanity_check; |
|
126 |
&preparation; |
|
127 |
&print_message; |
|
128 |
&xml_merge_output; |
|
129 |
&finalize; |
|
130 |
}
|
|
131 |
elsif ($KEYS_STYLE_ARG && @ARGV > 2) |
|
132 |
{
|
|
133 |
&utf8_sanity_check; |
|
134 |
&preparation; |
|
135 |
&print_message; |
|
136 |
&keys_merge_translations; |
|
137 |
&finalize; |
|
138 |
}
|
|
139 |
elsif ($DESKTOP_STYLE_ARG && @ARGV > 2) |
|
140 |
{
|
|
141 |
&utf8_sanity_check; |
|
142 |
&preparation; |
|
143 |
&print_message; |
|
144 |
&desktop_merge_translations; |
|
145 |
&finalize; |
|
146 |
}
|
|
147 |
elsif ($SCHEMAS_STYLE_ARG && @ARGV > 2) |
|
148 |
{
|
|
149 |
&utf8_sanity_check; |
|
150 |
&preparation; |
|
151 |
&print_message; |
|
152 |
&schemas_merge_translations; |
|
153 |
&finalize; |
|
154 |
}
|
|
155 |
elsif ($RFC822DEB_STYLE_ARG && @ARGV > 2) |
|
156 |
{
|
|
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 |
"ed_merge_translations; |
|
168 |
&finalize; |
|
169 |
}
|
|
170 |
else
|
|
171 |
{
|
|
172 |
&print_help; |
|
173 |
}
|
|
174 |
||
175 |
exit; |
|
176 |
||
177 |
## Sub for printing release information
|
|
178 |
sub print_version |
|
179 |
{
|
|
180 |
print <<_EOF_; |
|
181 |
${PROGRAM} (${PACKAGE}) ${VERSION} |
|
182 |
Written by Maciej Stachowiak, Darin Adler and Kenneth Christiansen. |
|
183 |
||
184 |
Copyright (C) 2000-2003 Free Software Foundation, Inc. |
|
185 |
Copyright (C) 2000-2001 Eazel, Inc. |
|
186 |
This is free software; see the source for copying conditions. There is NO |
|
187 |
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. |
|
188 |
_EOF_
|
|
189 |
exit; |
|
190 |
}
|
|
191 |
||
192 |
## Sub for printing usage information
|
|
193 |
sub print_help |
|
194 |
{
|
|
195 |
print <<_EOF_; |
|
196 |
Usage: ${PROGRAM} [OPTION]... PO_DIRECTORY FILENAME OUTPUT_FILE |
|
197 |
Generates an output file that includes some localized attributes from an |
|
198 |
untranslated source file. |
|
199 |
||
200 |
Mandatory options: (exactly one must be specified) |
|
201 |
-b, --ba-style includes translations in the bonobo-activation style |
|
202 |
-d, --desktop-style includes translations in the desktop style |
|
203 |
-k, --keys-style includes translations in the keys style |
|
204 |
-s, --schemas-style includes translations in the schemas style |
|
205 |
-r, --rfc822deb-style includes translations in the RFC822 style |
|
206 |
--quoted-style includes translations in the quoted string style |
|
207 |
-x, --xml-style includes translations in the standard xml style |
|
208 |
||
209 |
Other options: |
|
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 |
|
213 |
-m, --multiple-output output one localized file per locale, instead of |
|
214 |
a single file containing all localized elements |
|
215 |
-c, --cache=FILE specify cache file name |
|
216 |
(usually \$top_builddir/po/.intltool-merge-cache) |
|
217 |
-q, --quiet suppress most messages |
|
218 |
--help display this help and exit |
|
219 |
--version output version information and exit |
|
220 |
||
221 |
Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE") |
|
222 |
or send email to <xml-i18n-tools\@gnome.org>. |
|
223 |
_EOF_
|
|
224 |
exit; |
|
225 |
}
|
|
226 |
||
227 |
||
228 |
## Sub for printing error messages
|
|
229 |
sub print_error |
|
230 |
{
|
|
231 |
print STDERR "Try `${PROGRAM} --help' for more information.\n"; |
|
232 |
exit; |
|
233 |
}
|
|
234 |
||
235 |
||
236 |
sub print_message |
|
237 |
{
|
|
238 |
print "Merging translations into $OUTFILE.\n" unless $QUIET_ARG; |
|
239 |
}
|
|
240 |
||
241 |
||
242 |
sub preparation |
|
243 |
{
|
|
244 |
$PO_DIR = $ARGV[0]; |
|
245 |
$FILE = $ARGV[1]; |
|
246 |
$OUTFILE = $ARGV[2]; |
|
247 |
||
248 |
&gather_po_files; |
|
249 |
&get_translation_database; |
|
250 |
}
|
|
251 |
||
252 |
# General-purpose code for looking up translations in .po files
|
|
253 |
||
254 |
sub po_file2lang |
|
255 |
{
|
|
256 |
my ($tmp) = @_; |
|
257 |
$tmp =~ s/^.*\/(.*)\.po$/$1/; |
|
258 |
return $tmp; |
|
259 |
}
|
|
260 |
||
261 |
sub gather_po_files |
|
262 |
{
|
|
263 |
for my $po_file (glob "$PO_DIR/*.po") { |
|
264 |
$po_files_by_lang{po_file2lang($po_file)} = $po_file; |
|
265 |
}
|
|
266 |
}
|
|
267 |
||
268 |
sub get_local_charset |
|
269 |
{
|
|
270 |
my ($encoding) = @_; |
|
271 |
my $alias_file = $ENV{"G_CHARSET_ALIAS"} || "@INTLTOOL_LIBDIR@/charset.alias"; |
|
272 |
||
273 |
# seek character encoding aliases in charset.alias (glib)
|
|
274 |
||
275 |
if (open CHARSET_ALIAS, $alias_file) |
|
276 |
{
|
|
277 |
while (<CHARSET_ALIAS>) |
|
278 |
{
|
|
279 |
next if /^\#/; |
|
280 |
return $1 if (/^\s*([-._a-zA-Z0-9]+)\s+$encoding\b/i) |
|
281 |
}
|
|
282 |
||
283 |
close CHARSET_ALIAS; |
|
284 |
}
|
|
285 |
||
286 |
# if not found, return input string
|
|
287 |
||
288 |
return $encoding; |
|
289 |
}
|
|
290 |
||
291 |
sub get_po_encoding |
|
292 |
{
|
|
293 |
my ($in_po_file) = @_; |
|
294 |
my $encoding = ""; |
|
295 |
||
296 |
open IN_PO_FILE, $in_po_file or die; |
|
297 |
while (<IN_PO_FILE>) |
|
298 |
{
|
|
299 |
## example: "Content-Type: text/plain; charset=ISO-8859-1\n"
|
|
300 |
if (/Content-Type\:.*charset=([-a-zA-Z0-9]+)\\n/) |
|
301 |
{
|
|
302 |
$encoding = $1; |
|
303 |
last; |
|
304 |
}
|
|
305 |
}
|
|
306 |
close IN_PO_FILE; |
|
307 |
||
308 |
if (!$encoding) |
|
309 |
{
|
|
310 |
print STDERR "Warning: no encoding found in $in_po_file. Assuming ISO-8859-1\n" unless $QUIET_ARG; |
|
311 |
$encoding = "ISO-8859-1"; |
|
312 |
}
|
|
313 |
||
314 |
system ("$iconv -f $encoding -t UTF-8 <$devnull 2>$devnull"); |
|
315 |
if ($?) { |
|
316 |
$encoding = get_local_charset($encoding); |
|
317 |
}
|
|
318 |
||
319 |
return $encoding |
|
320 |
}
|
|
321 |
||
322 |
sub utf8_sanity_check |
|
323 |
{
|
|
324 |
print STDERR "Warning: option --pass-through has been removed.\n" if $PASS_THROUGH_ARG; |
|
325 |
$UTF8_ARG = 1; |
|
326 |
}
|
|
327 |
||
328 |
sub get_translation_database |
|
329 |
{
|
|
330 |
if ($cache_file) { |
|
331 |
&get_cached_translation_database; |
|
332 |
} else { |
|
333 |
&create_translation_database; |
|
334 |
}
|
|
335 |
}
|
|
336 |
||
337 |
sub get_newest_po_age |
|
338 |
{
|
|
339 |
my $newest_age; |
|
340 |
||
341 |
foreach my $file (values %po_files_by_lang) |
|
342 |
{
|
|
343 |
my $file_age = -M $file; |
|
344 |
$newest_age = $file_age if !$newest_age || $file_age < $newest_age; |
|
345 |
}
|
|
346 |
||
347 |
$newest_age = 0 if !$newest_age; |
|
348 |
||
349 |
return $newest_age; |
|
350 |
}
|
|
351 |
||
352 |
sub create_cache |
|
353 |
{
|
|
354 |
print "Generating and caching the translation database\n" unless $QUIET_ARG; |
|
355 |
||
356 |
&create_translation_database; |
|
357 |
||
358 |
open CACHE, ">$cache_file" || die; |
|
359 |
print CACHE join "\x01", %translations; |
|
360 |
close CACHE; |
|
361 |
}
|
|
362 |
||
363 |
sub load_cache |
|
364 |
{
|
|
365 |
print "Found cached translation database\n" unless $QUIET_ARG; |
|
366 |
||
367 |
my $contents; |
|
368 |
open CACHE, "<$cache_file" || die; |
|
369 |
{
|
|
370 |
local $/; |
|
371 |
$contents = <CACHE>; |
|
372 |
}
|
|
373 |
close CACHE; |
|
374 |
%translations = split "\x01", $contents; |
|
375 |
}
|
|
376 |
||
377 |
sub get_cached_translation_database |
|
378 |
{
|
|
379 |
my $cache_file_age = -M $cache_file; |
|
380 |
if (defined $cache_file_age) |
|
381 |
{
|
|
382 |
if ($cache_file_age <= &get_newest_po_age) |
|
383 |
{
|
|
384 |
&load_cache; |
|
385 |
return; |
|
386 |
}
|
|
387 |
print "Found too-old cached translation database\n" unless $QUIET_ARG; |
|
388 |
}
|
|
389 |
||
390 |
&create_cache; |
|
391 |
}
|
|
392 |
||
393 |
sub create_translation_database |
|
394 |
{
|
|
395 |
for my $lang (keys %po_files_by_lang) |
|
396 |
{
|
|
397 |
my $po_file = $po_files_by_lang{$lang}; |
|
398 |
||
399 |
if ($UTF8_ARG) |
|
400 |
{
|
|
401 |
my $encoding = get_po_encoding ($po_file); |
|
402 |
||
403 |
if (lc $encoding eq "utf-8") |
|
404 |
{
|
|
405 |
open PO_FILE, "<$po_file"; |
|
406 |
}
|
|
407 |
else
|
|
408 |
{
|
|
409 |
print "NOTICE: $po_file is not in UTF-8 but $encoding, converting...\n" unless $QUIET_ARG;; |
|
410 |
||
411 |
open PO_FILE, "$iconv -f $encoding -t UTF-8 $po_file|"; |
|
412 |
}
|
|
413 |
}
|
|
414 |
else
|
|
415 |
{
|
|
416 |
open PO_FILE, "<$po_file"; |
|
417 |
}
|
|
418 |
||
419 |
my $nextfuzzy = 0; |
|
420 |
my $inmsgid = 0; |
|
421 |
my $inmsgstr = 0; |
|
422 |
my $msgid = ""; |
|
423 |
my $msgstr = ""; |
|
424 |
||
425 |
while (<PO_FILE>) |
|
426 |
{
|
|
427 |
$nextfuzzy = 1 if /^#, fuzzy/; |
|
428 |
||
429 |
if (/^msgid "((\\.|[^\\]+)*)"/ ) |
|
430 |
{
|
|
431 |
$translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr; |
|
432 |
$msgid = ""; |
|
433 |
$msgstr = ""; |
|
434 |
||
435 |
if ($nextfuzzy) { |
|
436 |
$inmsgid = 0; |
|
437 |
} else { |
|
438 |
$msgid = unescape_po_string($1); |
|
439 |
$inmsgid = 1; |
|
440 |
}
|
|
441 |
$inmsgstr = 0; |
|
442 |
$nextfuzzy = 0; |
|
443 |
}
|
|
444 |
||
445 |
if (/^msgstr "((\\.|[^\\]+)*)"/) |
|
446 |
{
|
|
447 |
$msgstr = unescape_po_string($1); |
|
448 |
$inmsgstr = 1; |
|
449 |
$inmsgid = 0; |
|
450 |
}
|
|
451 |
||
452 |
if (/^"((\\.|[^\\]+)*)"/) |
|
453 |
{
|
|
454 |
$msgid .= unescape_po_string($1) if $inmsgid; |
|
455 |
$msgstr .= unescape_po_string($1) if $inmsgstr; |
|
456 |
}
|
|
457 |
}
|
|
458 |
$translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr; |
|
459 |
}
|
|
460 |
}
|
|
461 |
||
462 |
sub finalize |
|
463 |
{
|
|
464 |
}
|
|
465 |
||
466 |
sub unescape_one_sequence |
|
467 |
{
|
|
468 |
my ($sequence) = @_; |
|
469 |
||
470 |
return "\\" if $sequence eq "\\\\"; |
|
471 |
return "\"" if $sequence eq "\\\""; |
|
472 |
return "\n" if $sequence eq "\\n"; |
|
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
|
|
484 |
||
485 |
return $sequence; |
|
486 |
}
|
|
487 |
||
488 |
sub unescape_po_string |
|
489 |
{
|
|
490 |
my ($string) = @_; |
|
491 |
||
492 |
$string =~ s/(\\x[0-9a-fA-F]{2}|\\[0-7]{3}|\\.)/unescape_one_sequence($1)/eg; |
|
493 |
||
494 |
return $string; |
|
495 |
}
|
|
496 |
||
497 |
## NOTE: deal with < - < but not > - > because it seems its ok to have
|
|
498 |
## > in the entity. For further info please look at #84738.
|
|
499 |
sub entity_decode |
|
500 |
{
|
|
501 |
local ($_) = @_; |
|
502 |
||
503 |
s/'/'/g; # ' |
|
504 |
s/"/"/g; # " |
|
505 |
s/&/&/g; |
|
506 |
s/</</g; |
|
507 |
||
508 |
return $_; |
|
509 |
}
|
|
510 |
||
511 |
# entity_encode: (string)
|
|
512 |
#
|
|
513 |
# Encode the given string to XML format (encode '<' etc).
|
|
514 |
||
515 |
sub entity_encode |
|
516 |
{
|
|
517 |
my ($pre_encoded) = @_; |
|
518 |
||
519 |
my @list_of_chars = unpack ('C*', $pre_encoded); |
|
520 |
||
521 |
# with UTF-8 we only encode minimalistic
|
|
522 |
return join ('', map (&entity_encode_int_minimalist, @list_of_chars)); |
|
523 |
}
|
|
524 |
||
525 |
sub entity_encode_int_minimalist |
|
526 |
{
|
|
527 |
return """ if $_ == 34; |
|
528 |
return "&" if $_ == 38; |
|
529 |
return "'" if $_ == 39; |
|
530 |
return "<" if $_ == 60; |
|
531 |
return chr $_; |
|
532 |
}
|
|
533 |
||
534 |
sub entity_encoded_translation |
|
535 |
{
|
|
536 |
my ($lang, $string) = @_; |
|
537 |
||
538 |
my $translation = $translations{$lang, $string}; |
|
539 |
return $string if !$translation; |
|
540 |
return entity_encode ($translation); |
|
541 |
}
|
|
542 |
||
543 |
## XML (bonobo-activation specific) merge code
|
|
544 |
||
545 |
sub ba_merge_translations |
|
546 |
{
|
|
547 |
my $source; |
|
548 |
||
549 |
{
|
|
550 |
local $/; # slurp mode |
|
551 |
open INPUT, "<$FILE" or die "can't open $FILE: $!"; |
|
552 |
$source = <INPUT>; |
|
553 |
close INPUT; |
|
554 |
}
|
|
555 |
||
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'; |
|
559 |
||
560 |
while ($source =~ s|^(.*?)([ \t]*<\s*$w+\s+($w+\s*=\s*"$q"\s*)+/?>)([ \t]*\n)?||s) |
|
561 |
{
|
|
562 |
print OUTPUT $1; |
|
563 |
||
564 |
my $node = $2 . "\n"; |
|
565 |
||
566 |
my @strings = (); |
|
567 |
$_ = $node; |
|
568 |
while (s/(\s)_($w+\s*=\s*"($q)")/$1$2/s) { |
|
569 |
push @strings, entity_decode($3); |
|
570 |
}
|
|
571 |
print OUTPUT; |
|
572 |
||
573 |
my %langs; |
|
574 |
for my $string (@strings) |
|
575 |
{
|
|
576 |
for my $lang (keys %po_files_by_lang) |
|
577 |
{
|
|
578 |
$langs{$lang} = 1 if $translations{$lang, $string}; |
|
579 |
}
|
|
580 |
}
|
|
581 |
||
582 |
for my $lang (sort keys %langs) |
|
583 |
{
|
|
584 |
$_ = $node; |
|
585 |
s/(\sname\s*=\s*)"($q)"/$1"$2-$lang"/s; |
|
586 |
s/(\s)_($w+\s*=\s*")($q)"/$1 . $2 . entity_encoded_translation($lang, $3) . '"'/seg; |
|
587 |
print OUTPUT; |
|
588 |
}
|
|
589 |
}
|
|
590 |
||
591 |
print OUTPUT $source; |
|
592 |
||
593 |
close OUTPUT; |
|
594 |
}
|
|
595 |
||
596 |
||
597 |
## XML (non-bonobo-activation) merge code
|
|
598 |
||
599 |
||
600 |
# Process tag attributes
|
|
601 |
# Only parameter is a HASH containing attributes -> values mapping
|
|
602 |
sub getAttributeString |
|
603 |
{
|
|
604 |
my $sub = shift; |
|
605 |
my $do_translate = shift || 0; |
|
606 |
my $language = shift || ""; |
|
607 |
my $result = ""; |
|
608 |
my $translate = shift; |
|
609 |
foreach my $e (reverse(sort(keys %{ $sub }))) { |
|
610 |
my $key = $e; |
|
611 |
my $string = $sub->{$e}; |
|
612 |
my $quote = '"'; |
|
613 |
||
614 |
$string =~ s/^[\s]+//; |
|
615 |
$string =~ s/[\s]+$//; |
|
616 |
||
617 |
if ($string =~ /^'.*'$/) |
|
618 |
{
|
|
619 |
$quote = "'"; |
|
620 |
}
|
|
621 |
$string =~ s/^['"]//g; |
|
622 |
$string =~ s/['"]$//g; |
|
623 |
||
624 |
if ($do_translate && $key =~ /^_/) { |
|
625 |
$key =~ s|^_||g; |
|
626 |
if ($language) { |
|
627 |
# Handle translation
|
|
628 |
my $decode_string = entity_decode($string); |
|
629 |
my $translation = $translations{$language, $decode_string}; |
|
630 |
if ($translation) { |
|
631 |
$translation = entity_encode($translation); |
|
632 |
$string = $translation; |
|
633 |
}
|
|
634 |
$$translate = 2; |
|
635 |
} else { |
|
636 |
$$translate = 2 if ($translate && (!$$translate)); # watch not to "overwrite" $translate |
|
637 |
}
|
|
638 |
}
|
|
639 |
||
640 |
$result .= " $key=$quote$string$quote"; |
|
641 |
}
|
|
642 |
return $result; |
|
643 |
}
|
|
644 |
||
645 |
# Returns a translatable string from XML node, it works on contents of every node in XML::Parser tree
|
|
646 |
sub getXMLstring |
|
647 |
{
|
|
648 |
my $ref = shift; |
|
649 |
my $spacepreserve = shift || 0; |
|
650 |
my @list = @{ $ref }; |
|
651 |
my $result = ""; |
|
652 |
||
653 |
my $count = scalar(@list); |
|
654 |
my $attrs = $list[0]; |
|
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 |
while ($index < $count) { |
|
661 |
my $type = $list[$index]; |
|
662 |
my $content = $list[$index+1]; |
|
663 |
if (! $type ) { |
|
664 |
# We've got CDATA
|
|
665 |
if ($content) { |
|
666 |
# lets strip the whitespace here, and *ONLY* here
|
|
667 |
$content =~ s/\s+/ /gs if (!$spacepreserve); |
|
668 |
$result .= $content; |
|
669 |
}
|
|
670 |
} elsif ( "$type" ne "1" ) { |
|
671 |
# We've got another element
|
|
672 |
$result .= "<$type"; |
|
673 |
$result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements |
|
674 |
if ($content) { |
|
675 |
my $subresult = getXMLstring($content, $spacepreserve); |
|
676 |
if ($subresult) { |
|
677 |
$result .= ">".$subresult . "</$type>"; |
|
678 |
} else { |
|
679 |
$result .= "/>"; |
|
680 |
}
|
|
681 |
} else { |
|
682 |
$result .= "/>"; |
|
683 |
}
|
|
684 |
}
|
|
685 |
$index += 2; |
|
686 |
}
|
|
687 |
return $result; |
|
688 |
}
|
|
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 |
||
735 |
sub traverse |
|
736 |
{
|
|
737 |
my $fh = shift; |
|
738 |
my $nodename = shift; |
|
739 |
my $content = shift; |
|
740 |
my $language = shift || ""; |
|
741 |
my $spacepreserve = shift || 0; |
|
742 |
||
743 |
if (!$nodename) { |
|
744 |
if ($content =~ /^[\s]*$/) { |
|
745 |
$leading_space .= $content; |
|
746 |
}
|
|
747 |
print $fh $content; |
|
748 |
} else { |
|
749 |
# element
|
|
750 |
my @all = @{ $content }; |
|
751 |
my $attrs = shift @all; |
|
752 |
my $translate = 0; |
|
753 |
my $outattr = getAttributeString($attrs, 1, $language, \$translate); |
|
754 |
||
755 |
if ($nodename =~ /^_/) { |
|
756 |
$translate = 1; |
|
757 |
$nodename =~ s/^_//; |
|
758 |
}
|
|
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 |
||
764 |
print $fh "<$nodename", $outattr; |
|
765 |
if ($translate) { |
|
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 |
||
785 |
return; # this means there will be no same translation with xml:lang="$language"... |
|
786 |
# if we want them both, just remove this "return"
|
|
787 |
} else { |
|
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>"; |
|
795 |
}
|
|
796 |
} else { |
|
797 |
print $fh "/>"; |
|
798 |
}
|
|
799 |
||
800 |
for my $lang (sort keys %po_files_by_lang) { |
|
801 |
if ($MULTIPLE_OUTPUT && $lang ne "$language") { |
|
802 |
next; |
|
803 |
}
|
|
804 |
if ($lang) { |
|
805 |
# Handle translation
|
|
806 |
#
|
|
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) { |
|
815 |
print $fh "\n"; |
|
816 |
$leading_space =~ s/.*\n//g; |
|
817 |
print $fh $leading_space; |
|
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>"; |
|
825 |
}
|
|
826 |
}
|
|
827 |
}
|
|
828 |
||
829 |
} else { |
|
830 |
my $count = scalar(@all); |
|
831 |
if ($count > 0) { |
|
832 |
print $fh ">"; |
|
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 |
}
|
|
840 |
print $fh "</$nodename>"; |
|
841 |
} else { |
|
842 |
print $fh "/>"; |
|
843 |
}
|
|
844 |
}
|
|
845 |
}
|
|
846 |
}
|
|
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 |
||
876 |
sub intltool_tree_char |
|
877 |
{
|
|
878 |
my $expat = shift; |
|
879 |
my $text = shift; |
|
880 |
my $clist = $expat->{Curlist}; |
|
881 |
my $pos = $#$clist; |
|
882 |
||
883 |
# Use original_string so that we retain escaped entities
|
|
884 |
# in CDATA sections.
|
|
885 |
#
|
|
886 |
if ($pos > 0 and $clist->[$pos - 1] eq '0') { |
|
887 |
$clist->[$pos] .= $expat->original_string(); |
|
888 |
} else { |
|
889 |
push @$clist, 0 => $expat->original_string(); |
|
890 |
}
|
|
891 |
}
|
|
892 |
||
893 |
sub intltool_tree_start |
|
894 |
{
|
|
895 |
my $expat = shift; |
|
896 |
my $tag = shift; |
|
897 |
my @origlist = (); |
|
898 |
||
899 |
# Use original_string so that we retain escaped entities
|
|
900 |
# in attribute values. We must convert the string to an
|
|
901 |
# @origlist array to conform to the structure of the Tree
|
|
902 |
# Style.
|
|
903 |
#
|
|
904 |
my @original_array = split /\x/, $expat->original_string(); |
|
905 |
my $source = $expat->original_string(); |
|
906 |
||
907 |
# Remove leading tag.
|
|
908 |
#
|
|
909 |
$source =~ s|^\s*<\s*(\S+)||s; |
|
910 |
||
911 |
# Grab attribute key/value pairs and push onto @origlist array.
|
|
912 |
#
|
|
913 |
while ($source) |
|
914 |
{
|
|
915 |
if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/) |
|
916 |
{
|
|
917 |
$source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s; |
|
918 |
push @origlist, $1; |
|
919 |
push @origlist, '"' . $2 . '"'; |
|
920 |
}
|
|
921 |
elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/) |
|
922 |
{
|
|
923 |
$source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s; |
|
924 |
push @origlist, $1; |
|
925 |
push @origlist, "'" . $2 . "'"; |
|
926 |
}
|
|
927 |
else
|
|
928 |
{
|
|
929 |
last; |
|
930 |
}
|
|
931 |
}
|
|
932 |
||
933 |
my $ol = [ { @origlist } ]; |
|
934 |
||
935 |
push @{ $expat->{Lists} }, $expat->{Curlist}; |
|
936 |
push @{ $expat->{Curlist} }, $tag => $ol; |
|
937 |
$expat->{Curlist} = $ol; |
|
938 |
}
|
|
939 |
||
940 |
sub readXml |
|
941 |
{
|
|
942 |
my $filename = shift || return; |
|
943 |
if(!-f $filename) { |
|
944 |
die "ERROR Cannot find filename: $filename\n"; |
|
945 |
}
|
|
946 |
||
947 |
my $ret = eval 'require XML::Parser'; |
|
948 |
if(!$ret) { |
|
949 |
die "You must have XML::Parser installed to run $0\n\n"; |
|
950 |
}
|
|
951 |
my $xp = new XML::Parser(Style => 'Tree'); |
|
952 |
$xp->setHandlers(Char => \&intltool_tree_char); |
|
953 |
$xp->setHandlers(Start => \&intltool_tree_start); |
|
954 |
$xp->setHandlers(CdataStart => \&intltool_tree_cdatastart); |
|
955 |
$xp->setHandlers(CdataEnd => \&intltool_tree_cdataend); |
|
956 |
my $tree = $xp->parsefile($filename); |
|
957 |
||
958 |
# <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
|
|
959 |
# would be:
|
|
960 |
# [foo, [{}, head, [{id => "a"}, 0, "Hello ", em, [{}, 0, "there"]], bar, [{},
|
|
961 |
# 0, "Howdy", ref, [{}]], 0, "do" ] ]
|
|
962 |
||
963 |
return $tree; |
|
964 |
}
|
|
965 |
||
966 |
sub print_header |
|
967 |
{
|
|
968 |
my $infile = shift; |
|
969 |
my $fh = shift; |
|
970 |
my $source; |
|
971 |
||
972 |
if(!-f $infile) { |
|
973 |
die "ERROR Cannot find filename: $infile\n"; |
|
974 |
}
|
|
975 |
||
976 |
print $fh qq{<?xml version="1.0" encoding="UTF-8"?>\n}; |
|
977 |
{
|
|
978 |
local $/; |
|
979 |
open DOCINPUT, "<${FILE}" or die; |
|
980 |
$source = <DOCINPUT>; |
|
981 |
close DOCINPUT; |
|
982 |
}
|
|
983 |
if ($source =~ /(<!DOCTYPE.*\[.*\]\s*>)/s) |
|
984 |
{
|
|
985 |
print $fh "$1\n"; |
|
986 |
}
|
|
987 |
elsif ($source =~ /(<!DOCTYPE[^>]*>)/s) |
|
988 |
{
|
|
989 |
print $fh "$1\n"; |
|
990 |
}
|
|
991 |
}
|
|
992 |
||
993 |
sub parseTree |
|
994 |
{
|
|
995 |
my $fh = shift; |
|
996 |
my $ref = shift; |
|
997 |
my $language = shift || ""; |
|
998 |
||
999 |
my $name = shift @{ $ref }; |
|
1000 |
my $cont = shift @{ $ref }; |
|
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); |
|
1012 |
}
|
|
1013 |
||
1014 |
sub xml_merge_output |
|
1015 |
{
|
|
1016 |
my $source; |
|
1017 |
||
1018 |
if ($MULTIPLE_OUTPUT) { |
|
1019 |
for my $lang (sort keys %po_files_by_lang) { |
|
1020 |
if ( ! -d $lang ) { |
|
1021 |
mkdir $lang or -d $lang or die "Cannot create subdirectory $lang: $!\n"; |
|
1022 |
}
|
|
1023 |
open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n"; |
|
1024 |
binmode (OUTPUT) if $^O eq 'MSWin32'; |
|
1025 |
my $tree = readXml($FILE); |
|
1026 |
print_header($FILE, \*OUTPUT); |
|
1027 |
parseTree(\*OUTPUT, $tree, $lang); |
|
1028 |
close OUTPUT; |
|
1029 |
print "CREATED $lang/$OUTFILE\n" unless $QUIET_ARG; |
|
1030 |
}
|
|
1031 |
}
|
|
1032 |
open OUTPUT, ">$OUTFILE" or die "Cannot open $OUTFILE: $!\n"; |
|
1033 |
binmode (OUTPUT) if $^O eq 'MSWin32'; |
|
1034 |
my $tree = readXml($FILE); |
|
1035 |
print_header($FILE, \*OUTPUT); |
|
1036 |
parseTree(\*OUTPUT, $tree); |
|
1037 |
close OUTPUT; |
|
1038 |
print "CREATED $OUTFILE\n" unless $QUIET_ARG; |
|
1039 |
}
|
|
1040 |
||
1041 |
sub keys_merge_translations |
|
1042 |
{
|
|
1043 |
open INPUT, "<${FILE}" or die; |
|
1044 |
open OUTPUT, ">${OUTFILE}" or die; |
|
1045 |
binmode (OUTPUT) if $^O eq 'MSWin32'; |
|
1046 |
||
1047 |
while (<INPUT>) |
|
1048 |
{
|
|
1049 |
if (s/^(\s*)_(\w+=(.*))/$1$2/) |
|
1050 |
{
|
|
1051 |
my $string = $3; |
|
1052 |
||
1053 |
print OUTPUT; |
|
1054 |
||
1055 |
my $non_translated_line = $_; |
|
1056 |
||
1057 |
for my $lang (sort keys %po_files_by_lang) |
|
1058 |
{
|
|
1059 |
my $translation = $translations{$lang, $string}; |
|
1060 |
next if !$translation; |
|
1061 |
||
1062 |
$_ = $non_translated_line; |
|
1063 |
s/(\w+)=.*/[$lang]$1=$translation/; |
|
1064 |
print OUTPUT; |
|
1065 |
}
|
|
1066 |
}
|
|
1067 |
else
|
|
1068 |
{
|
|
1069 |
print OUTPUT; |
|
1070 |
}
|
|
1071 |
}
|
|
1072 |
||
1073 |
close OUTPUT; |
|
1074 |
close INPUT; |
|
1075 |
}
|
|
1076 |
||
1077 |
sub desktop_merge_translations |
|
1078 |
{
|
|
1079 |
open INPUT, "<${FILE}" or die; |
|
1080 |
open OUTPUT, ">${OUTFILE}" or die; |
|
1081 |
binmode (OUTPUT) if $^O eq 'MSWin32'; |
|
1082 |
||
1083 |
while (<INPUT>) |
|
1084 |
{
|
|
1085 |
if (s/^(\s*)_(\w+=(.*))/$1$2/) |
|
1086 |
{
|
|
1087 |
my $string = $3; |
|
1088 |
||
1089 |
print OUTPUT; |
|
1090 |
||
1091 |
my $non_translated_line = $_; |
|
1092 |
||
1093 |
for my $lang (sort keys %po_files_by_lang) |
|
1094 |
{
|
|
1095 |
my $translation = $translations{$lang, $string}; |
|
1096 |
next if !$translation; |
|
1097 |
||
1098 |
$_ = $non_translated_line; |
|
1099 |
s/(\w+)=.*/${1}[$lang]=$translation/; |
|
1100 |
print OUTPUT; |
|
1101 |
}
|
|
1102 |
}
|
|
1103 |
else
|
|
1104 |
{
|
|
1105 |
print OUTPUT; |
|
1106 |
}
|
|
1107 |
}
|
|
1108 |
||
1109 |
close OUTPUT; |
|
1110 |
close INPUT; |
|
1111 |
}
|
|
1112 |
||
1113 |
sub schemas_merge_translations |
|
1114 |
{
|
|
1115 |
my $source; |
|
1116 |
||
1117 |
{
|
|
1118 |
local $/; # slurp mode |
|
1119 |
open INPUT, "<$FILE" or die "can't open $FILE: $!"; |
|
1120 |
$source = <INPUT>; |
|
1121 |
close INPUT; |
|
1122 |
}
|
|
1123 |
||
1124 |
open OUTPUT, ">$OUTFILE" or die; |
|
1125 |
binmode (OUTPUT) if $^O eq 'MSWin32'; |
|
1126 |
||
1127 |
# FIXME: support attribute translations
|
|
1128 |
||
1129 |
# Empty nodes never need translation, so unmark all of them.
|
|
1130 |
# For example, <_foo/> is just replaced by <foo/>.
|
|
1131 |
$source =~ s|<\s*_($w+)\s*/>|<$1/>|g; |
|
1132 |
||
1133 |
while ($source =~ s/ |
|
1134 |
(.*?) |
|
1135 |
(\s+)(<locale\ name="C">(\s*) |
|
1136 |
(<default>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/default>)?(\s*) |
|
1137 |
(<short>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/short>)?(\s*) |
|
1138 |
(<long>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/long>)?(\s*) |
|
1139 |
<\/locale>) |
|
1140 |
//sx) |
|
1141 |
{
|
|
1142 |
print OUTPUT $1; |
|
1143 |
||
1144 |
my $locale_start_spaces = $2 ? $2 : ''; |
|
1145 |
my $default_spaces = $4 ? $4 : ''; |
|
1146 |
my $short_spaces = $7 ? $7 : ''; |
|
1147 |
my $long_spaces = $10 ? $10 : ''; |
|
1148 |
my $locale_end_spaces = $13 ? $13 : ''; |
|
1149 |
my $c_default_block = $3 ? $3 : ''; |
|
1150 |
my $default_string = $6 ? $6 : ''; |
|
1151 |
my $short_string = $9 ? $9 : ''; |
|
1152 |
my $long_string = $12 ? $12 : ''; |
|
1153 |
||
1154 |
print OUTPUT "$locale_start_spaces$c_default_block"; |
|
1155 |
||
1156 |
$default_string =~ s/\s+/ /g; |
|
1157 |
$default_string = entity_decode($default_string); |
|
1158 |
$short_string =~ s/\s+/ /g; |
|
1159 |
$short_string = entity_decode($short_string); |
|
1160 |
$long_string =~ s/\s+/ /g; |
|
1161 |
$long_string = entity_decode($long_string); |
|
1162 |
||
1163 |
for my $lang (sort keys %po_files_by_lang) |
|
1164 |
{
|
|
1165 |
my $default_translation = $translations{$lang, $default_string}; |
|
1166 |
my $short_translation = $translations{$lang, $short_string}; |
|
1167 |
my $long_translation = $translations{$lang, $long_string}; |
|
1168 |
||
1169 |
next if (!$default_translation && !$short_translation && |
|
1170 |
!$long_translation); |
|
1171 |
||
1172 |
print OUTPUT "\n$locale_start_spaces<locale name=\"$lang\">"; |
|
1173 |
||
1174 |
print OUTPUT "$default_spaces"; |
|
1175 |
||
1176 |
if ($default_translation) |
|
1177 |
{
|
|
1178 |
$default_translation = entity_encode($default_translation); |
|
1179 |
print OUTPUT "<default>$default_translation</default>"; |
|
1180 |
}
|
|
1181 |
||
1182 |
print OUTPUT "$short_spaces"; |
|
1183 |
||
1184 |
if ($short_translation) |
|
1185 |
{
|
|
1186 |
$short_translation = entity_encode($short_translation); |
|
1187 |
print OUTPUT "<short>$short_translation</short>"; |
|
1188 |
}
|
|
1189 |
||
1190 |
print OUTPUT "$long_spaces"; |
|
1191 |
||
1192 |
if ($long_translation) |
|
1193 |
{
|
|
1194 |
$long_translation = entity_encode($long_translation); |
|
1195 |
print OUTPUT "<long>$long_translation</long>"; |
|
1196 |
}
|
|
1197 |
||
1198 |
print OUTPUT "$locale_end_spaces</locale>"; |
|
1199 |
}
|
|
1200 |
}
|
|
1201 |
||
1202 |
print OUTPUT $source; |
|
1203 |
||
1204 |
close OUTPUT; |
|
1205 |
}
|
|
1206 |
||
1207 |
sub rfc822deb_merge_translations |
|
1208 |
{
|
|
1209 |
my %encodings = (); |
|
1210 |
for my $lang (keys %po_files_by_lang) { |
|
1211 |
$encodings{$lang} = ($UTF8_ARG ? 'UTF-8' : get_po_encoding($po_files_by_lang{$lang})); |
|
1212 |
}
|
|
1213 |
||
1214 |
my $source; |
|
1215 |
||
1216 |
$Text::Wrap::huge = 'overflow'; |
|
1217 |
$Text::Wrap::break = qr/\n|\s(?=\S)/; |
|
1218 |
||
1219 |
{
|
|
1220 |
local $/; # slurp mode |
|
1221 |
open INPUT, "<$FILE" or die "can't open $FILE: $!"; |
|
1222 |
$source = <INPUT>; |
|
1223 |
close INPUT; |
|
1224 |
}
|
|
1225 |
||
1226 |
open OUTPUT, ">${OUTFILE}" or die; |
|
1227 |
binmode (OUTPUT) if $^O eq 'MSWin32'; |
|
1228 |
||
1229 |
while ($source =~ /(^|\n+)(_*)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg) |
|
1230 |
{
|
|
1231 |
my $sep = $1; |
|
1232 |
my $non_translated_line = $3.$4; |
|
1233 |
my $string = $5; |
|
1234 |
my $underscore = length($2); |
|
1235 |
next if $underscore eq 0 && $non_translated_line =~ /^#/; |
|
1236 |
# Remove [] dummy strings
|
|
1237 |
my $stripped = $string; |
|
1238 |
$stripped =~ s/\[\s[^\[\]]*\],/,/g if $underscore eq 2; |
|
1239 |
$stripped =~ s/\[\s[^\[\]]*\]$//; |
|
1240 |
$non_translated_line .= $stripped; |
|
1241 |
||
1242 |
print OUTPUT $sep.$non_translated_line; |
|
1243 |
||
1244 |
if ($underscore) |
|
1245 |
{
|
|
1246 |
my @str_list = rfc822deb_split($underscore, $string); |
|
1247 |
||
1248 |
for my $lang (sort keys %po_files_by_lang) |
|
1249 |
{
|
|
1250 |
my $is_translated = 1; |
|
1251 |
my $str_translated = ''; |
|
1252 |
my $first = 1; |
|
1253 |
||
1254 |
for my $str (@str_list) |
|
1255 |
{
|
|
1256 |
my $translation = $translations{$lang, $str}; |
|
1257 |
||
1258 |
if (!$translation) |
|
1259 |
{
|
|
1260 |
$is_translated = 0; |
|
1261 |
last; |
|
1262 |
}
|
|
1263 |
||
1264 |
# $translation may also contain [] dummy
|
|
1265 |
# strings, mostly to indicate an empty string
|
|
1266 |
$translation =~ s/\[\s[^\[\]]*\]$//; |
|
1267 |
||
1268 |
if ($first) |
|
1269 |
{
|
|
1270 |
if ($underscore eq 2) |
|
1271 |
{
|
|
1272 |
$str_translated .= $translation; |
|
1273 |
}
|
|
1274 |
else
|
|
1275 |
{
|
|
1276 |
$str_translated .= |
|
1277 |
Text::Tabs::expand($translation) . |
|
1278 |
"\n"; |
|
1279 |
}
|
|
1280 |
}
|
|
1281 |
else
|
|
1282 |
{
|
|
1283 |
if ($underscore eq 2) |
|
1284 |
{
|
|
1285 |
$str_translated .= ', ' . $translation; |
|
1286 |
}
|
|
1287 |
else
|
|
1288 |
{
|
|
1289 |
$str_translated .= Text::Tabs::expand( |
|
1290 |
Text::Wrap::wrap(' ', ' ', $translation)) . |
|
1291 |
"\n .\n"; |
|
1292 |
}
|
|
1293 |
}
|
|
1294 |
$first = 0; |
|
1295 |
||
1296 |
# To fix some problems with Text::Wrap::wrap
|
|
1297 |
$str_translated =~ s/(\n )+\n/\n .\n/g; |
|
1298 |
}
|
|
1299 |
next unless $is_translated; |
|
1300 |
||
1301 |
$str_translated =~ s/\n \.\n$//; |
|
1302 |
$str_translated =~ s/\s+$//; |
|
1303 |
||
1304 |
$_ = $non_translated_line; |
|
1305 |
s/^(\w+):\s*.*/$sep${1}-$lang.$encodings{$lang}: $str_translated/s; |
|
1306 |
print OUTPUT; |
|
1307 |
}
|
|
1308 |
}
|
|
1309 |
}
|
|
1310 |
print OUTPUT "\n"; |
|
1311 |
||
1312 |
close OUTPUT; |
|
1313 |
close INPUT; |
|
1314 |
}
|
|
1315 |
||
1316 |
sub rfc822deb_split |
|
1317 |
{
|
|
1318 |
# Debian defines a special way to deal with rfc822-style files:
|
|
1319 |
# when a value contain newlines, it consists of
|
|
1320 |
# 1. a short form (first line)
|
|
1321 |
# 2. a long description, all lines begin with a space,
|
|
1322 |
# and paragraphs are separated by a single dot on a line
|
|
1323 |
# This routine returns an array of all paragraphs, and reformat
|
|
1324 |
# them.
|
|
1325 |
# When first argument is 2, the string is a comma separated list of
|
|
1326 |
# values.
|
|
1327 |
my $type = shift; |
|
1328 |
my $text = shift; |
|
1329 |
$text =~ s/^[ \t]//mg; |
|
1330 |
return (split(/, */, $text, 0)) if $type ne 1; |
|
1331 |
return ($text) if $text !~ /\n/; |
|
1332 |
||
1333 |
$text =~ s/([^\n]*)\n//; |
|
1334 |
my @list = ($1); |
|
1335 |
my $str = ''; |
|
1336 |
||
1337 |
for my $line (split (/\n/, $text)) |
|
1338 |
{
|
|
1339 |
chomp $line; |
|
1340 |
if ($line =~ /^\.\s*$/) |
|
1341 |
{
|
|
1342 |
# New paragraph
|
|
1343 |
$str =~ s/\s*$//; |
|
1344 |
push(@list, $str); |
|
1345 |
$str = ''; |
|
1346 |
}
|
|
1347 |
elsif ($line =~ /^\s/) |
|
1348 |
{
|
|
1349 |
# Line which must not be reformatted
|
|
1350 |
$str .= "\n" if length ($str) && $str !~ /\n$/; |
|
1351 |
$line =~ s/\s+$//; |
|
1352 |
$str .= $line."\n"; |
|
1353 |
}
|
|
1354 |
else
|
|
1355 |
{
|
|
1356 |
# Continuation line, remove newline
|
|
1357 |
$str .= " " if length ($str) && $str !~ /\n$/; |
|
1358 |
$str .= $line; |
|
1359 |
}
|
|
1360 |
}
|
|
1361 |
||
1362 |
$str =~ s/\s*$//; |
|
1363 |
push(@list, $str) if length ($str); |
|
1364 |
||
1365 |
return @list; |
|
1366 |
}
|
|
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/\"(([^\"]|\\\")*[^\\\"])\"/"\"" . "ed_translation($lang, $1) . "\""/ge; |
|
1398 |
print OUTPUT; |
|
1399 |
}
|
|
1400 |
close OUTPUT; |
|
1401 |
close INPUT; |
|
1402 |
}
|
|
1403 |
}
|