source: osm/applications/editors/josm/i18n/i18n.pl@ 33802

Last change on this file since 33802 was 33152, checked in by stoecker, 8 years ago

support tag2link format as well

  • Property svn:executable set to *
File size: 12.3 KB
Line 
1#! /usr/bin/perl -w
2
3use utf8;
4use strict;
5use open qw/:std :encoding(utf8)/;
6use Term::ReadKey;
7use Encode;
8
9my $waswarn = 0;
10my $lang_pattern = '([a-z]{2}_[A-Z]{2}|[a-z]{2,3}|[a-z]{2}\@[a-z]+)';
11my $lang_pattern_file = '([a-z]{2}_[A-Z]{2}|[a-z]{2,3}|[a-z]{2}-[a-z]+)';
12
13main();
14
15sub getdate
16{
17 my @t=gmtime();
18 return sprintf("%04d-%02d-%02d %02d:%02d+0000",
19 1900+$t[5],$t[4]+1,$t[3],$t[2],$t[1]);
20}
21
22sub loadpot($)
23{
24 my ($file) = @_;
25 my %all = ();
26 my %keys = ();
27 die "Could not open file $file." if(!open FILE,"<:utf8",$file);
28 my %postate = (last => "", type => "");
29 my $linenum = 0;
30 print "Reading file $file\n";
31 while(<FILE>)
32 {
33 ++$linenum;
34 my $fn = "$file:$linenum";
35 chomp;
36 if($_ =~ /^#/ || !$_)
37 {
38 checkpo(\%postate, \%all, "pot", "line $linenum in $file", \%keys, 1, undef);
39 $postate{fuzzy} = 1 if ($_ =~ /fuzzy/);
40 }
41 elsif($_ =~ /^"(.*)"$/) {$postate{last} .= $1;}
42 elsif($_ =~ /^(msg.+) "(.*)"$/)
43 {
44 my ($n, $d) = ($1, $2);
45 my $new = !${postate}{fuzzy} && (($n eq "msgid" && $postate{type} ne "msgctxt") || ($n eq "msgctxt"));
46 checkpo(\%postate, \%all, "pot", "line $linenum in $file", \%keys, $new, undef);
47 $postate{last} = $d;
48 $postate{type} = $n;
49 $postate{src} = $fn if $new;
50 }
51 else
52 {
53 die "Strange line $linenum in $file: $_.";
54 }
55 }
56 checkpo(\%postate, \%all, "pot", "line $linenum in $file", \%keys, 1, undef);
57 close(FILE);
58 return \%all;
59}
60
61sub loadfiles($$@)
62{
63 my $desc;
64 my %all = ();
65 my %keys = ();
66 my ($lang,$use,@files) = @_;
67 foreach my $file (@files)
68 {
69 die "Could not open file $file." if(!open FILE,"<:utf8",$file);
70
71 if($file =~ /\/$lang_pattern\.po$/)
72 {
73 my $l = $1;
74 ++$lang->{$l};
75 my %postate = (last => "", type => "");
76 my $linenum = 0;
77 print "Reading file $file (lang $l)\n";
78 while(<FILE>)
79 {
80 ++$linenum;
81 my $fn = "$file:$linenum";
82 chomp;
83 if($_ =~ /^#/ || !$_)
84 {
85 checkpo(\%postate, \%all, $l, "line $linenum in $file", \%keys, 1, $use);
86 $postate{fuzzy} = 1 if ($_ =~ /fuzzy/);
87 }
88 elsif($_ =~ /^"(.*)"$/) {$postate{last} .= $1;}
89 elsif($_ =~ /^(msg.+) "(.*)"$/)
90 {
91 my ($n, $d) = ($1, $2);
92 my $new = !${postate}{fuzzy} && (($n eq "msgid" && $postate{type} ne "msgctxt") || ($n eq "msgctxt"));
93 checkpo(\%postate, \%all, $l, "line $linenum in $file", \%keys, $new, $use);
94 $postate{last} = $d;
95 $postate{type} = $n;
96 $postate{src} = $fn if $new;
97 }
98 else
99 {
100 die "Strange line $linenum in $file: $_.";
101 }
102 }
103 checkpo(\%postate, \%all, $l, "line $linenum in $file", \%keys, 1, $use);
104 }
105 else
106 {
107 die "File format not supported for file $file.";
108 }
109 close(FILE);
110 }
111 return %all;
112}
113
114my $alwayspo = 0;
115my $alwaysup = 0;
116my $noask = 0;
117my %conflicts;
118sub copystring($$$$$$$)
119{
120 my ($data, $en, $l, $str, $txt, $context, $ispo) = @_;
121
122 $en = "___${context}___$en" if $context;
123
124 if(exists($data->{$en}{$l}) && $data->{$en}{$l} ne $str)
125 {
126 return if !$str;
127 if($l =~ /^_/)
128 {
129 $data->{$en}{$l} .= ";$str" if !($data->{$en}{$l} =~ /$str/);
130 }
131 elsif(!$data->{$en}{$l})
132 {
133 $data->{$en}{$l} = $str;
134 }
135 else
136 {
137 my $f = $data->{$en}{_file} || "";
138 $f = ($f ? "$f;".$data->{$en}{"_src.$l"} : $data->{$en}{"_src.$l"}) if $data->{$en}{"_src.$l"};
139 my $isotherpo = ($f =~ /\.po\:/);
140 my $pomode = ($ispo && !$isotherpo) || (!$ispo && $isotherpo);
141
142 my $mis = "String mismatch for '$en' **$str** ($txt) != **$data->{$en}{$l}** ($f)\n";
143 my $replace = 0;
144
145 if(($conflicts{$l}{$str} || "") eq $data->{$en}{$l}) {}
146 elsif($pomode && $alwaysup) { $replace=$isotherpo; }
147 elsif($pomode && $alwayspo) { $replace=$ispo; }
148 elsif($noask) { print $mis; ++$waswarn; }
149 else
150 {
151 ReadMode 4; # Turn off controls keys
152 my $arg = "(l)eft, (r)ight";
153 $arg .= ", (p)o, (u)pstream[ts/mat], all p(o), all up(s)tream" if $pomode;
154 $arg .= ", e(x)it: ";
155 print "$mis$arg";
156 while((my $c = getc()))
157 {
158 if($c eq "l") { $replace=1; }
159 elsif($c eq "r") {}
160 elsif($c eq "p" && $pomode) { $replace=$ispo; }
161 elsif($c eq "u" && $pomode) { $replace=$isotherpo; }
162 elsif($c eq "o" && $pomode) { $alwayspo = 1; $replace=$ispo; }
163 elsif($c eq "s" && $pomode) { $alwaysup = 1; $replace=$isotherpo; }
164 elsif($c eq "x") { $noask = 1; ++$waswarn; }
165 else { print "\n$arg"; next; }
166 last;
167 }
168 print("\n");
169 ReadMode 0; # Turn on controls keys
170 }
171 if(!$noask)
172 {
173 if($replace)
174 {
175 $data->{$en}{$l} = $str;
176 $conflicts{$l}{$data->{$en}{$l}} = $str;
177 }
178 else
179 {
180 $conflicts{$l}{$str} = $data->{$en}{$l};
181 }
182 }
183 }
184 }
185 else
186 {
187 $data->{$en}{$l} = $str;
188 }
189}
190
191# Check a current state for new data
192#
193# @param postate Pointer to current status hash
194# @param data Pointer to final data array
195# @param l current language
196# @param txt output text in case of error, usually file and line number
197# @param keys pointer to hash for info keys extracted from the first msgid "" entry
198# @param new whether a data set is finish or not yet complete
199# @param use hash to strings to use or undef for all strings
200#
201sub checkpo($$$$$$$)
202{
203 my ($postate, $data, $l, $txt, $keys, $new, $use) = @_;
204
205 if($postate->{type} eq "msgid") {$postate->{msgid} = $postate->{last};}
206 elsif($postate->{type} eq "msgid_plural") {$postate->{msgid_1} = $postate->{last};}
207 elsif($postate->{type} =~ /^msgstr(\[0\])?$/) {$postate->{msgstr} = $postate->{last};}
208 elsif($postate->{type} =~ /^msgstr\[(.+)\]$/) {$postate->{"msgstr_$1"} = $postate->{last};}
209 elsif($postate->{type} eq "msgctxt") {$postate->{context} = $postate->{last};}
210 elsif($postate->{type}) { die "Strange type $postate->{type} found\n" }
211
212 if($new)
213 {
214 my $en = $postate->{context} ? "___$postate->{context}___$postate->{msgid}" : $postate->{msgid};
215 if((!$postate->{fuzzy}) && ($l eq "pot" || $postate->{msgstr}) && $postate->{msgid}
216 && (!$use || $use->{$en}))
217 {
218 copystring($data, $postate->{msgid}, $l, $postate->{msgstr},$txt,$postate->{context}, 1);
219 if(!$use || $use->{$en}{"en.1"})
220 {
221 for(my $i = 1; exists($postate->{"msgstr_$i"}); ++$i)
222 { copystring($data, $postate->{msgid}, "$l.$i", $postate->{"msgstr_$i"},$txt,$postate->{context}, 1); }
223 if($postate->{msgid_1})
224 { copystring($data, $postate->{msgid}, "en.1", $postate->{msgid_1},$txt,$postate->{context}, 1); }
225 }
226 copystring($data, $postate->{msgid}, "_src.$l", $postate->{src},$txt,$postate->{context}, 1);
227 }
228 elsif($postate->{msgstr} && !$postate->{msgid})
229 {
230 my %k = ($postate->{msgstr} =~ /(.+?): +(.+?)\\n/g);
231 # take the first one!
232 for $a (sort keys %k)
233 {
234 $keys->{$l}{$a} = $k{$a} if !$keys->{$l}{$a};
235 }
236 }
237 foreach my $k (keys %{$postate})
238 {
239 delete $postate->{$k};
240 }
241 $postate->{type} = $postate->{last} = "";
242 }
243}
244
245sub makestring($)
246{
247 my ($str) = @_;
248 $str =~ s/\\"/"/g;
249 $str =~ s/\\\\/\\/g;
250 $str =~ s/\\n/\n/g;
251 $str = encode("utf8", $str);
252 return $str;
253}
254
255sub checkstring
256{
257 my ($la, $tr, $en, $cnt, $en1, $eq) = @_;
258 $tr = makestring($tr);
259 $en = makestring($en);
260 $cnt = $cnt || 0;
261 $en1 = makestring($en1) if defined($en1);
262 my $error = 0;
263
264 # Test one - are there single quotes which don't occur twice
265 my $v = $tr;
266 $v =~ s/''//g; # replace all twice occuring single quotes
267 $v =~ s/'[{}]'//g; # replace all bracketquoting single quotes
268 if($v =~ /'/)#&& $la ne "en")
269 {
270 warn "JAVA translation issue for language $la: Mismatching single quotes:\nTranslated text: ".decode("utf8",$tr)."\nOriginal text: ".decode("utf8",$en)."\n";
271 $error = 1;
272 }
273 # Test two - check if there are {..} which should not be
274 my @fmt = ();
275 my $fmt;
276 my $fmte;
277 my $fmte1 = "";
278 my $trt = $tr; $trt =~ s/'[{}]'//g;
279 while($trt =~ /\{(.*?)\}/g) {push @fmt,$1};
280 while($trt =~ /\%([a-z]+)\%/g) {push @fmt,$1};
281 $fmt = join("_", sort @fmt); @fmt = ();
282 my $ent = $en; $ent =~ s/'[{}]'//g;
283 while($ent =~ /\{(.*?)\}/g) {push @fmt,$1};
284 while($ent =~ /\%([a-z]+)\%/g) {push @fmt,$1};
285 $fmte = join("_", sort @fmt); @fmt = ();
286 if($en1)
287 {
288 my $en1t = $en1; $en1t =~ s/'[{}]'//g;
289 while($en1t =~ /\{(.*?)\}/g) {push @fmt,$1}; $fmte1 = join("_", sort @fmt);
290 }
291 if($fmt ne $fmte && $fmt ne $fmte1)
292 {
293 if(!($fmte eq '0' && $fmt eq "" && $cnt == 1)) # Don't warn when a single value is left for first multi-translation
294 {
295 warn "JAVA translation issue for language $la ($cnt): Mismatching format entries:\nTranslated text: ".decode("utf8",$tr)."\nOriginal text: ".decode("utf8",$en)."\n";
296 $error = 1;
297 }
298 }
299
300 #$tr = "" if($error && $la ne "en");
301 return pack("n",65534) if $eq;
302
303 return pack("n",length($tr)).$tr;
304}
305
306sub createlang($@)
307{
308 my ($data, @files) = @_;
309 my $maxlen = 0;
310 foreach my $file (@files)
311 {
312 my $len = length($file);
313 $maxlen = $len if $len > $maxlen;
314 }
315 my $maxcount = keys(%{$data});
316 foreach my $file (@files)
317 {
318 my $la;
319 my $cnt = 0;
320 if($file =~ /^(?:.*\/)?$lang_pattern_file\.lang$/)
321 {
322 $la = $1;
323 $la =~ s/-/\@/;
324 }
325 else
326 {
327 die "Language for file $file unknown.";
328 }
329 die "Could not open outfile $file\n" if !open FILE,">:raw",$file;
330
331 foreach my $en (sort keys %{$data})
332 {
333 next if $data->{$en}{"en.1"};
334 my $val;
335 my $eq;
336 if($la eq "en")
337 {
338 ++$cnt;
339 $val = $en;
340 $val =~ s/^___(.*)___/_:$1\n/;
341 }
342 else
343 {
344 my $ennoctx = $en;
345 $ennoctx =~ s/^___(.*)___//;
346 $val = (exists($data->{$en}{$la})) ? $data->{$en}{$la} : "";
347 ++$cnt if $val;
348 if($ennoctx eq $val)
349 {
350 $val = ""; $eq = 1;
351 }
352 }
353 print FILE checkstring($la, $val, $en, undef, undef, $eq);
354 }
355 print FILE pack "n",0xFFFF;
356 foreach my $en (sort keys %{$data})
357 {
358 next if !$data->{$en}{"en.1"};
359 my $num;
360 for($num = 1; exists($data->{$en}{"$la.$num"}); ++$num)
361 { }
362 my $val;
363 my $eq = 0;
364 if($la eq "en")
365 {
366 ++$cnt;
367 $val = $en;
368 $val =~ s/^___(.*)___/_:$1\n/;
369 }
370 else
371 {
372 $val = (exists($data->{$en}{$la})) ? $data->{$en}{$la} : "";
373 --$num if(!$val);
374 ++$cnt if $val;
375 if($num == 2)
376 {
377 my $ennoctx = $en;
378 $ennoctx =~ s/^___(.*)___//;
379 if($val eq $ennoctx && $data->{$en}{"$la.1"} eq $data->{$en}{"en.1"})
380 {
381 $num = 0;
382 $eq = 1;
383 }
384 }
385 }
386
387 print FILE pack "C",$eq ? 0xFE : $num;
388 if($num)
389 {
390 print FILE checkstring($la, $val, $en, 1, $data->{$en}{"en.1"});
391 for($num = 1; exists($data->{$en}{"$la.$num"}); ++$num)
392 {
393 print FILE checkstring($la, $data->{$en}{"$la.$num"}, $en, $num+1, $data->{$en}{"en.1"});
394 }
395 }
396 }
397 close FILE;
398 if(!$cnt)
399 {
400 unlink $file;
401 printf "Skipped file %-${maxlen}s: Contained 0 strings out of %5d.\n",$file,$maxcount;
402 }
403 else
404 {
405 printf "Created file %-${maxlen}s: Added %5d strings out of %5d (%5.1f%%).\n",$file,$cnt,$maxcount,,$cnt*100.0/$maxcount-5e-2;
406 }
407 }
408}
409
410sub main
411{
412 my %lang;
413 my @po;
414 my $potfile;
415 my $basename = "./";
416 foreach my $arg (@ARGV)
417 {
418 next if $arg !~ /^--/;
419 if($arg =~ /^--basedir=(.+)$/)
420 {
421 $basename = $1;
422 }
423 elsif($arg =~ /^--potfile=(.+)$/)
424 {
425 $potfile = $1;
426 }
427 else
428 {
429 die "Unknown argument $arg.";
430 }
431 }
432 $basename .= "/" if !($basename =~ /[\/\\:]$/);
433 foreach my $arg (@ARGV)
434 {
435 next if $arg =~ /^--/;
436 foreach my $f (glob $arg)
437 {
438 if($f =~ /\*/) { printf "Skipping $f\n"; }
439 elsif($f =~ /\.po$/) { push(@po, $f); }
440 else { die "unknown file extension."; }
441 }
442 }
443 my %data = loadfiles(\%lang,$potfile ? loadpot($potfile) : undef, @po);
444
445 my @clang;
446 foreach my $la (sort keys %lang)
447 {
448 $la =~ s/\@/-/;
449 push(@clang, "${basename}$la.lang");
450 }
451 push(@clang, "${basename}en.lang");
452 die "There have been warning. No output.\n" if $waswarn;
453
454 createlang(\%data, @clang);
455}
Note: See TracBrowser for help on using the repository browser.