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

Last change on this file since 29943 was 28423, checked in by Dirk Stoecker, 7 years ago

fix basename handling

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