1 #!@XML_I18N_TOOLS_PERL@ -w
2
3 #
4 # The XML Translation Merge Tool
5 #
6 # Copyright (C) 2000 Free Software Foundation.
7 # Copyright (C) 2000, 2001 Eazel, Inc
8 #
9 # This library is free software; you can redistribute it and/or
10 # modify it under the terms of the GNU General Public License as
11 # published by the Free Software Foundation; either version 2 of the
12 # License, or (at your option) any later version.
13 #
14 # This script 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 library; if not, write to the Free Software
21 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
22 #
23 # Authors: Maciej Stachowiak <mjs@eazel.com>
24 # Kenneth Christiansen <kenneth@gnu.org>
25 # Darin Adler <darin@eazel.com>
26 #
27
28
29 ## Release information
30 my $PROGRAM = "xml-i18n-merge";
31 my $PACKAGE = "xml-i18n-tools";
32 my $VERSION = "0.9";
33
34 ## Script options - Enable by setting value to 1
35 my $ENABLE_XML = "1";
36
37 ## Loaded modules
38 use strict;
39 use File::Basename;
40 use Getopt::Long;
41
42 ## Scalars used by the option stuff
43 my $HELP_ARG = "0";
44 my $VERSION_ARG = "0";
45 my $OAF_STYLE_ARG = "0";
46 my $XML_STYLE_ARG = "0";
47 my $KEYS_STYLE_ARG = "0";
48 my $DESKTOP_STYLE_ARG = "0";
49 my $QUIET_ARG = "0";
50
51
52 ## Handle options
53 GetOptions (
54 "help|h|?" => \$HELP_ARG,
55 "version|v" => \$VERSION_ARG,
56 "quiet|q" => \$QUIET_ARG,
57 "oaf-style|o" => \$OAF_STYLE_ARG,
58 "xml-style|x" => \$XML_STYLE_ARG,
59 "keys-style|k" => \$KEYS_STYLE_ARG,
60 "desktop-style|d" => \$DESKTOP_STYLE_ARG
61 ) or &error;
62
63
64 my $PO_DIR;
65 my $FILE;
66 my $OUTFILE;
67
68 my @languages;
69 my %po_files_by_lang = ();
70 my %translations = ();
71
72 &split_on_argument;
73
74
75 ## Check for options.
76 ## This section will check for the different options.
77
78 sub split_on_argument {
79
80 if ($VERSION_ARG) {
81 &version;
82
83 } elsif ($HELP_ARG) {
84 &help;
85 } elsif ($OAF_STYLE_ARG && @ARGV > 2) {
86 &place_normal;
87 &message;
88 &preparation;
89 &oaf_merge_translations;
90 } elsif ($XML_STYLE_ARG && @ARGV > 2) {
91 &place_normal;
92 &message;
93 &preparation;
94 &xml_merge_translations;
95 } elsif ($KEYS_STYLE_ARG && @ARGV > 2) {
96 &place_normal;
97 &message;
98 &preparation;
99 &keys_merge_translations;
100 } elsif ($DESKTOP_STYLE_ARG && @ARGV > 2) {
101 &place_normal;
102 &message;
103 &preparation;
104 &desktop_merge_translations;
105 } else {
106 &help;
107 }
108 }
109
110
111 sub place_normal {
112 $PO_DIR = $ARGV[0];
113 $FILE = $ARGV[1];
114 $OUTFILE = $ARGV[2];
115 }
116
117
118 ## Sub for printing release information
119 sub version{
120 print "${PROGRAM} (${PACKAGE}) ${VERSION}\n";
121 print "Written by Maciej Stachowiak and Kenneth Christiansen, 2000.\n\n";
122 print "Copyright (C) 2000 Free Software Foundation, Inc.\n";
123 print "Copyright (C) 2000, 2001 Eazel, Inc.\n";
124 print "This is free software; see the source for copying conditions. There is NO\n";
125 print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
126 exit;
127 }
128
129 ## Sub for printing usage information
130 sub help{
131 print "Usage: ${PROGRAM} [OPTIONS] PO_DIRECTORY FILENAME OUTPUT_FILE\n";
132 print "Generates an xml file that includes translated versions of some attributes,\n";
133 print "from an untranslated source and a po directory that includes translations.\n";
134 print " -v, --version shows the version\n";
135 print " -h, --help shows this help page\n";
136 print " -q, --quiet quiet mode\n";
137 print " -o, --oaf-style includes translations in the oaf style\n";
138 print " -x, --xml-style includes translations in the xml style\n";
139 print " -k, --keys-style includes translations in the keys style\n";
140 print " -d, --desktop-style includes translations in the desktop style\n";
141 print "\nReport bugs to <mjs\@eazel.com>.\n";
142 exit;
143 }
144
145
146 ## Sub for printing error messages
147 sub error{
148 # print "xml-i18n-merge: invalid option @ARGV\n";
149 print "Try `${PROGRAM} --help' for more information.\n";
150 exit;
151 }
152
153
154 sub message {
155 print "Merging translations into $OUTFILE.\n" unless $QUIET_ARG;
156 }
157
158
159
160 sub preparation {
161 &gather_po_files;
162 &create_translation_database;
163 }
164
165
166
167 # General-purpose code for looking up translations in .po files
168
169 sub gather_po_files
170 {
171 my @po_files = glob("${PO_DIR}/*.po");
172
173 @languages = map (&po_file2lang, @po_files);
174
175 foreach my $lang (@languages) {
176 $po_files_by_lang{$lang} = shift (@po_files);
177 }
178 }
179
180 sub po_file2lang
181 {
182 my $tmp = $_;
183 $tmp =~ s/^.*\/(.*)\.po$/$1/;
184 return $tmp;
185 }
186
187
188 sub create_translation_database
189 {
190 foreach my $lang (@languages) {
191
192 my $po_file = $po_files_by_lang{$lang};
193
194 open PO_FILE, "<$po_file";
195
196 while (<PO_FILE>) {
197 if (/^#,.*fuzzy/) {
198 $_ = <PO_FILE>; next;
199 }
200 if (/^msgid "(.*)"/ ) {
201 my $msgid = $1;
202 $_ = <PO_FILE>;
203
204 if (/^msgstr "(.+)"/) {
205 my $msgstr = $1;
206 $translations{$lang . "|" . $msgid} = $msgstr;
207 # print "[$lang]$msgstr\n";
208 }
209 }
210 }
211 }
212 }
213
214 sub lookup_translations
215 {
216 my ($value) = @_;
217
218 my %transmap = ();
219
220 foreach my $lang (@languages) {
221 my $translation = lookup_translation ($value, $lang);
222
223 if ($translation) {
224 $transmap{$lang} = $translation;
225 }
226 }
227
228 return %transmap;
229 }
230
231
232 sub lookup_translation
233 {
234 my ($string, $lang) = @_;
235 $string =~ s/\+/\\+/g;
236
237 my $salt = "$lang|$string";
238
239 if ($translations{$salt}) {
240 return $translations{$salt};
241 }
242
243 return "";
244 }
245
246
247 sub entity_encode_translations
248 {
249 my %transmap = @_;
250
251 foreach my $key (keys %transmap) {
252 $transmap{$key} = entity_encode ($transmap{$key});
253 }
254
255 return %transmap;
256 }
257
258
259 sub entity_encode
260 {
261 my ($pre_encoded) = @_;
262
263 $pre_encoded =~ s/\\(.)/$1/g;
264 my @list_of_chars = unpack ('C*', $pre_encoded);
265
266 return join ('', map (&entity_encode_int, @list_of_chars));
267 }
268
269 sub entity_encode_int
270 {
271 if ($_ > 127 || $_ == 34 || $_ == 38) {
272 return "&#" . $_ . ";";
273 } else {
274 return chr $_;
275 }
276 }
277
278
279 ## XML/OAF-specific merge code
280
281 sub oaf_merge_translations
282 {
283 my $xml_source; {
284 local (*INPUT);
285 local $/; # slurp mode
286 open INPUT, "<$FILE" or die "can't open $FILE: $!";
287 $xml_source = <INPUT>;
288 close INPUT;
289 }
290
291 open OUTPUT, ">$OUTFILE";
292
293 while ($xml_source =~ /[ \t]*<[^<]*\s_\w+="[^"]*"[^<]*>/m) {
294 print OUTPUT $`;
295 my $orig_node = $&;
296 $xml_source = $';
297
298 my $non_translated_line = $orig_node;
299 $non_translated_line =~ s/_(\w+)="/$1="/;
300
301 my $new_node = $non_translated_line;
302
303 my $value_str = $orig_node;
304 $value_str =~ s/.*_\w+="([^"]*)".*/$1/s;
305
306 if ($value_str) {
307 my %value_translation_map = entity_encode_translations
308 (lookup_translations ($value_str));
309
310 foreach my $key (sort keys %value_translation_map) {
311 my $translation = $value_translation_map{$key};
312
313 my $translated_line = $orig_node;
314 $translated_line =~ s/name="([^"]*)"/name="$1-$key"/;
315 $translated_line =~ s/(\s*)_(\w+)="[^"]*"/$1$2="$translation"/;
316
317 $new_node .= "\n$translated_line";
318 }
319 }
320
321 $xml_source = $new_node . $xml_source;
322 }
323
324 print OUTPUT $xml_source;
325
326 close OUTPUT;
327 }
328
329
330 ## XML (non-OAF) merge code
331
332 sub xml_merge_translations
333 {
334 my $xml_source; {
335 local (*INPUT);
336 local $/; # slurp mode
337 open INPUT, "<$FILE" or die "can't open $FILE: $!";
338 $xml_source = <INPUT>;
339 close INPUT;
340 }
341
342 open OUTPUT, ">$OUTFILE";
343
344 # FIXME: support attribute translations
345
346 # First just unmark for translation all empty nodes
347 # for example <_foo/> is just replaced by <foo/>
348 $xml_source =~ s/<_(\w+)\/>/<$1\/>/mg;
349
350 # Support for XML <_foo>blah</_foo> style translations
351 while ($xml_source =~ /([ \t]*)<_(\w+)>([^<]+)<\/_\2>/m) {
352 print OUTPUT $`;
353 $xml_source = $';
354
355 my $spaces = $1;
356 my $tag_name = $2;
357 my $value_str = $3;
358
359 my $non_translated_line = "$spaces<$tag_name>$value_str</$tag_name>";
360
361 my $new_node = $non_translated_line;
362
363 if ($value_str) {
364 my %value_translation_map = entity_encode_translations
365 (lookup_translations ($value_str));
366
367 foreach my $key (sort keys %value_translation_map) {
368 my $translation = $value_translation_map{$key};
369
370 $new_node .= "\n$spaces<$tag_name xml:lang=\"$key\">$translation</$tag_name>";
371 }
372 }
373
374 $xml_source = $new_node . $xml_source;
375 }
376
377 print OUTPUT $xml_source;
378
379 close OUTPUT;
380 }
381
382 sub keys_merge_translations
383 {
384 open INPUT, "<${FILE}";
385
386 open OUTPUT, ">${OUTFILE}";
387
388 while (<INPUT>) {
389 chomp;
390 if (/^\s*_\w+=.*/) {
391 my $orig_line = $_;
392
393 my $non_translated_line = $orig_line;
394 $non_translated_line =~ s/_([^="]*)=/$1=/;
395
396 print OUTPUT "${non_translated_line}\n";
397
398 my $value_str = $orig_line;
399 $value_str =~ s/.*_\w+=(.*)/$1/;
400
401 if ($value_str) {
402 my %value_translation_map = lookup_translations ($value_str);
403
404 foreach my $key (sort keys %value_translation_map) {
405 my $translation = $value_translation_map{$key};
406
407 my $translated_line = $orig_line;
408 $translated_line =~ s/_([^="]*)=([^\n]*)/\[$key]$1=$translation/;
409 print OUTPUT "$translated_line\n";
410 }
411 }
412 } else {
413 print OUTPUT "$_\n";
414 }
415 }
416
417 close OUTPUT;
418 close INPUT;
419 }
420
421 sub desktop_merge_translations
422 {
423 open INPUT, "<${FILE}";
424
425 open OUTPUT, ">${OUTFILE}";
426
427 while (<INPUT>) {
428 chomp;
429 if (/^\s*_\w+=.*/) {
430 my $orig_line = $_;
431
432 my $non_translated_line = $orig_line;
433 $non_translated_line =~ s/_([^="]*)=/$1=/;
434
435 print OUTPUT "${non_translated_line}\n";
436
437 my $value_str = $orig_line;
438 $value_str =~ s/.*_\w+=(.*)/$1/;
439
440 if ($value_str) {
441 my %value_translation_map = lookup_translations ($value_str);
442
443 foreach my $key (sort keys %value_translation_map) {
444 my $translation = $value_translation_map{$key};
445
446 my $translated_line = $orig_line;
447 $translated_line =~ s/^_([^="]*)=([^\n]*)/$1\[$key]=$translation/;
448 print OUTPUT "$translated_line\n";
449 }
450 }
451 } else {
452 print OUTPUT "$_\n";
453 }
454 }
455
456 close OUTPUT;
457 close INPUT;
458
459 }
This page was automatically generated by the LXR engine.
Free-text search provided by Glimpse