source: subversion/applications/editors/josm/i18n/i18n.pl

Last change on this file was 33152, checked in by stoecker, 3 months 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.