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

Last change on this file since 34701 was 34025, checked in by stoecker, 7 years ago

add a note where to find the fileformat specification

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