source: subversion/applications/editors/merkaartor/translations/i18n.pl @ 13954

Last change on this file since 13954 was 13806, checked in by Dirk Stoecker, 11 years ago

fixed handlin of linefeed

File size: 15.3 KB
Line 
1#! /usr/bin/perl -w
2
3use utf8;
4use encoding "utf8";
5use Term::ReadKey;
6
7my $nocontext = 1;
8my $waswarn = 0;
9my $mail = "Merkaartor <merkaartor\@openstreetmap.org>";
10my %pokeys = (
11);
12
13# don't copy these from files
14my %defkeys = (
15  "X-Generator" => "Merkaartor translation convert",
16  "MIME-Version" => "1.0",
17  "Content-Type" => "text/plain; charset=UTF-8",
18  "Content-Transfer-Encoding" => "8bit",
19  "Project-Id-Version" => "merkaartor_templates 1.0",
20  "Report-Msgid-Bugs-To" => $mail,
21  "POT-Creation-Date" => getdate(),
22  "PO-Revision-Date" => getdate(),
23#  "Last-Translator" => $mail,
24#  "Language-Team" => $mail,
25#  "X-Launchpad-Export-Date" => getdate(),
26);
27
28main();
29
30sub getdate
31{
32  my @t=gmtime();
33  return sprintf("%04d-%02d-%02d %02d:%02d+0000",
34  1900+$t[5],$t[4]+1,$t[3],$t[2],$t[1]);
35}
36
37sub loadfiles($$@)
38{
39  my $desc;
40  my $all;
41  my ($lang,$keys,@files) = @_;
42  foreach my $file (@files)
43  {
44    die "Could not open file $file." if(!open FILE,"<:utf8",$file);
45    my $linenum = 0;
46    if($file =~ /\.mat$/)
47    {
48      while(my $line = <FILE>)
49      {
50        ++$linenum;
51        chomp $line;
52        if($line =~ /^ *<description +locale="([A-Za-z_]+)" *>(.*?)<\/description> *$/)
53        {
54          my $val = maketxt($2);
55          my $l = $1;
56          $desc{$l} = $val;
57          $desc{_file} = "$file:$linenum" if($l eq "en");
58        }
59        elsif($line =~ /description/)
60        {
61          die "Can't handle line $linenum in $file: $line";
62        }
63        elsif(%desc)
64        {
65          my $en = $desc{"en"};
66          die "No english string found in previous block line $linenum in $file: $line" if(!$en);
67          delete $desc{"en"};
68          foreach my $l (reverse sort keys %desc)
69          {
70            copystring(\%all, $en, $l, $desc{$l}, "line $linenum in $file", undef, 0);
71            ++$lang->{$l} if !($l =~ /^_/);
72          }
73          %desc = ();
74        }
75      }
76    }
77    elsif($file =~ /[-_](.._..)\.po$/ || $file =~ /^(?:.*\/)?(.._..)\.po$/ ||
78    $file =~ /[-_](..)\.po$/ || $file =~ /^(?:.*\/)?(..)\.po$/)
79    {
80      my $l = $1;
81      ++$lang->{$l};
82      my %postate = (last => "", type => "");
83      my $linenum = 0;
84      while(<FILE>)
85      {
86        ++$linenum;
87        my $fn = "$file:$linenum";
88        chomp;
89        if($_ =~ /^#/ || !$_)
90        {
91          checkpo(\%postate, \%all, $l, "line $linenum in $file", $keys, 1);
92          $postate{fuzzy} = 1 if ($_ =~ /fuzzy/);
93        }
94        elsif($_ =~ /^"(.*)"$/) {$postate{last} .= $1;}
95        elsif($_ =~ /^(msg.+) "(.*)"$/)
96        {
97          my ($n, $d) = ($1, $2);
98          my $new = $n eq "msgid";
99          checkpo(\%postate, \%all, $l, "line $linenum in $file", $keys, $new);
100          $postate{last} = $d;
101          $postate{type} = $n;
102          $postate{src} = $fn if $new;
103        }
104        else
105        {
106          die "Strange line $linenum in $file: $_.";
107        }
108      }
109      checkpo(\%postate, \%all, $l, "line $linenum in $file", $keys, 1);
110    }
111    elsif($file =~ /\.ts$/)
112    {
113      my $linenum = 0;
114      my $l;
115      my $ctx;
116      my $loc;
117      my $issource;
118      my $istrans;
119      my $source;
120      my @trans;
121      my $fuzzy;
122      my $numerus;
123      while(<FILE>)
124      {
125        s/\r//g;
126        ++$linenum;
127        if(/<name>(.*)<\/name>/) { $ctx = $1; }
128        elsif(/<location filename="(.*?)" line="(.*?)"\/>/) { $loc = "$1:$2"; }
129        elsif(/context>/){$ctx = undef;}
130        elsif(/message( numerus="yes")?>/)
131        {
132          my $n = $1;
133          die "No language found in file $file." if !$l;
134          if($source)
135          {
136            $source = maketxt($source);
137            if(!$fuzzy)
138            {
139              my $txt = "line $linenum in $file";
140              $txt .= ", $loc" if($loc);
141              for($i = 0; $i <= $#trans; ++$i)
142              {
143                copystring(\%all, $source, $i ? "$l.$i" : $l, maketxt($trans[$i]), $txt, $ctx, 0);
144              }
145              if(defined($numerus))
146              {
147                copystring(\%all, $source, "en.1", $source, $txt, $ctx, 0);
148              }
149            }
150            copystring(\%all, $source, "_file", $loc, $txt, $ctx, 0) if $loc;
151            copystring(\%all, $source, "_src.$l", "$file:$linenum", $txt, $ctx, 0);
152          }
153          @trans = undef;
154          $loc = $issource = $istrans = $source = $numerus = $fuzzy = undef;
155          $numerus = 0 if $n;
156        }
157        elsif(/<TS .* language="(.*)">/) { $l = getlang($1); ++$lang->{$l}; }
158        elsif(/<\?xml/ || /<!DOCTYPE/ || /<\/TS>/ || /<defaultcodec>/){} # ignore
159        # source
160        elsif(/<source>(.*)<\/source>/){$source = $1;}
161        elsif(/<source>(.*)/){$source = "$1\n"; $issource = 1;}
162        elsif($issource && /(.*)<\/source>/){$source .= $1; $issource = undef;}
163        elsif($issource){$source .= $_;}
164        # translation
165        elsif(defined($numerus) && /translation(?: type="(unfinished|obsolete)")?>/) {$fuzzy=$1;}
166        elsif(defined($numerus) && /<numerusform>(.*)<\/numerusform>/){$trans[$numerus++] = $1;}
167        elsif(defined($numerus) && /<numerusform>(.*)/){$trans[$numerus] = "$1\n"; $istrans = 1;}
168        elsif(defined($numerus) && $istrans && /(.*)<\/numerusform>/){$trans[$numerus++] .= $1; $istrans = undef;}
169        elsif(/<translation(?: type="(unfinished|obsolete)")?>(.*)<\/translation>/){$trans[0] = $2;$fuzzy=$1;}
170        elsif(/<translation(?: type="(unfinished|obsolete)")?>(.*)/){$trans[0] = "$2\n"; $istrans = 1;$fuzzy=$1;}
171        elsif($istrans && /(.*)<\/translation>/){$trans[0] .= $1; $istrans = undef;}
172        elsif($istrans){$trans[$numerus ? $numerus : 0] .= $_;}
173        else
174        {
175          die "Strange line $linenum in $file: $_.";
176        }
177
178      }
179    }
180    else
181    {
182      die "File format not supported for file $file.";
183    }
184    close(FILE);
185  }
186  return %all;
187}
188
189my $alwayspo = 0;
190my $alwaysup = 0;
191my $noask = 0;
192my $conflicts;
193sub copystring($$$$$$$)
194{
195  my ($data, $en, $l, $str, $txt, $context, $ispo) = @_;
196
197  $en = "___${context}___$en" if $context && !$nocontext;
198
199  if(exists($data->{$en}{$l}) && $data->{$en}{$l} ne $str)
200  {
201    return if !$str;
202    if($l =~ /^_/)
203    {
204      $data->{$en}{$l} .= ";$str" if !($data->{$en}{$l} =~ /$str/);
205    }
206    elsif(!$data->{$en}{$l})
207    {
208      $data->{$en}{$l} = $str;
209    }
210    else
211    {
212
213      my $f = $data->{$en}{_file} || "";
214      $f = ($f ? "$f;".$data->{$en}{"_src.$l"} : $data->{$en}{"_src.$l"}) if $data->{$en}{"_src.$l"};
215      my $isotherpo = ($f =~ /\.po\:/);
216      my $pomode = ($ispo && !$isotherpo) || (!$ispo && $isotherpo);
217
218      my $mis = "String mismatch for '$en' **$str** ($txt) != **$data->{$en}{$l}** ($f)\n";
219      my $replace = 0;
220
221      if(($conflicts{$l}{$str} || "") eq $data->{$en}{$l}) {}
222      elsif($pomode && $alwaysup) { $replace=$isotherpo; }
223      elsif($pomode && $alwayspo) { $replace=$ispo; }
224      elsif($noask) { print $mis; ++$waswarn; }
225      else
226      {
227        ReadMode 4; # Turn off controls keys
228        my $arg = "(l)eft, (r)ight";
229        $arg .= ", (p)o, (u)pstream[ts/mat], all p(o), all up(s)tream" if $pomode;
230        $arg .= ", e(x)it: ";
231        print "$mis$arg";
232        while((my $c = getc()))
233        {
234          if($c eq "l") { $replace=1; }
235          elsif($c eq "r") {}
236          elsif($c eq "p" && $pomode) { $replace=$ispo; }
237          elsif($c eq "u" && $pomode) { $replace=$isotherpo; }
238          elsif($c eq "o" && $pomode) { $alwayspo = 1; $replace=$ispo; }
239          elsif($c eq "s" && $pomode) { $alwaysup = 1; $replace=$isotherpo; }
240          elsif($c eq "x") { $noask = 1; ++$waswarn; }
241          else { print "\n$arg"; next; }
242          last;
243        }
244        print("\n");
245        ReadMode 0; # Turn on controls keys
246      }
247      if(!$noask)
248      {
249        if($replace)
250        {
251          $data->{$en}{$l} = $str;
252          $conflicts{$l}{$data->{$en}{$l}} = $str;
253        }
254        else
255        {
256          $conflicts{$l}{$str} = $data->{$en}{$l};
257        }
258      }
259    }
260  }
261  else
262  {
263    $data->{$en}{$l} = $str;
264  }
265}
266
267sub checkpo($$$$$$)
268{
269  my ($postate, $data, $l, $txt, $keys, $new) = @_;
270
271  if($postate->{type} eq "msgid") {$postate->{msgid} = $postate->{last};}
272  elsif($postate->{type} eq "msgid_plural") {$postate->{msgid_1} = $postate->{last};}
273  elsif($postate->{type} =~ /^msgstr(\[0\])?$/) {$postate->{msgstr} = $postate->{last};}
274  elsif($postate->{type} =~ /^msgstr\[(.+)\]$/) {$postate->{"msgstr_$1"} = $postate->{last};}
275  elsif($postate->{type} eq "msgctxt") {$postate->{context} = $postate->{last};}
276  elsif($postate->{type}) { die "Strange type $postate->{type} found\n" }
277
278  if($new)
279  {
280    if((!$postate->{fuzzy}) && $postate->{msgstr} && $postate->{msgid})
281    {
282      copystring($data, $postate->{msgid}, $l, $postate->{msgstr},$txt,$postate->{context}, 1);
283      for($i = 1; exists($postate->{"msgstr_$i"}); ++$i)
284      { copystring($data, $postate->{msgid}, "$l.$i", $postate->{"msgstr_$i"},$txt,$postate->{context}, 1); }
285      if($postate->{msgid_1})
286      { copystring($data, $postate->{msgid}, "en.1", $postate->{msgid_1},$txt,$postate->{context}, 1); }
287      copystring($data, $postate->{msgid}, "_src.$l", $postate->{src},$txt,$postate->{context}, 1);
288    }
289    elsif($postate->{msgstr} && !$postate->{msgid})
290    {
291      my %k = ($postate->{msgstr} =~ /(.+?): +(.+?)\\n/g);
292      # take the first one!
293      for $a (sort keys %k)
294      {
295        $keys->{$l}{$a} = $k{$a} if !$keys->{$l}{$a};
296      }
297    }
298    foreach my $k (keys %{$postate})
299    {
300      delete $postate->{$k};
301    }
302    $postate->{type} = $postate->{last} = "";
303  }
304}
305
306sub createpos($$@)
307{
308  my ($data, $keys, @files) = @_;
309  foreach my $file (@files)
310  {
311    my $head;
312    my $la;
313    if($file =~ /[-_](.._..)\.po$/ || $file =~ /^(?:.*\/)?(.._..)\.po$/ ||
314    $file =~ /[-_](..)\.po$/ || $file =~ /^(?:.*\/)?(..)\.po$/)
315    {
316      $la = $1;
317      $head = "# translation into language $la file $file\n";
318    }
319    elsif($file =~ /\.pot$/)
320    {
321      $la = "en";
322      $head = "# template file $file\n";
323    }
324    else
325    {
326      die "Language for file $file unknown.";
327    }
328    die "Could not open outfile $file\n" if !open FILE,">:utf8",$file;
329    print FILE "${head}msgid \"\"\nmsgstr \"\"\n";
330    my %k;
331    foreach my $k (keys %{$keys->{$la}}) { $k{$k} = $keys->{$la}{$k}; }
332    foreach my $k (keys %defkeys) { $k{$k} = $defkeys{$k}; }
333    foreach my $k (sort keys %k)
334    {
335      print FILE "\"$k: $k{$k}\\n\"\n";
336    }
337    print FILE "\n";
338
339    foreach my $en (sort keys %{$data})
340    {
341      my $ctx;
342      my $ennc = $en;
343      $ctx = $1 if $ennc =~ s/^___(.*)___//;
344      my $str = ($la ne "en" && exists($data->{$en}{$la})) ? $data->{$en}{$la} : "";
345      if($data->{$en}{_file})
346      {
347        foreach my $f (split ";",$data->{$en}{_file})
348        {
349          print FILE "#: $f\n"
350        }
351      }
352      else
353      {
354        next;
355        # print FILE "#: unknown:0\n"
356      }
357      if($ennc =~ /\%[0-9n]/)
358      { print FILE "#, c-format, qt-format\n"; }
359      elsif($ennc =~ /\%[ds]/)
360      { print FILE "#, c-format\n"; }
361      print FILE "msgctxt \"$ctx\"\n" if $ctx;
362      print FILE "msgid \"$ennc\"\n";
363      print FILE "msgid_plural \"$data->{$en}{\"en.1\"}\"\n" if $data->{$en}{"en.1"};
364      if($la ne "en" && (exists($data->{$en}{"$la.1"}) || $data->{$en}{"en.1"}))
365      {
366        print FILE "msgstr[0] \"$str\"\n";
367        for($i = 1; exists($data->{$en}{"$la.$i"}); ++$i)
368        { print FILE "msgstr[$i] \"$data->{$en}{\"$la.$i\"}\"\n"; }
369      }
370      else
371      {
372        print FILE "msgstr \"$str\"\n";
373      }
374      print FILE "\n";
375    }
376    close FILE;
377  }
378}
379
380sub maketxt($)
381{
382  my ($str) = @_;
383  $str =~ s/&gt;/>/g;
384  $str =~ s/&lt;/</g;
385  $str =~ s/"/\\"/g;
386  $str =~ s/&quot;/\\"/g;
387  $str =~ s/&apos;/'/g;
388  $str =~ s/&amp;/&/g;
389  $str =~ s/\n/\\n/g;
390  return $str;
391}
392
393sub makexml($)
394{
395  my ($str) = @_;
396  $str =~ s/&/&amp;/g;
397  $str =~ s/</&lt;/g;
398  $str =~ s/>/&gt;/g;
399  $str =~ s/\\"/&quot;/g;
400  $str =~ s/'/&apos;/g;
401  $str =~ s/\\n/\n/g;
402  return $str;
403}
404
405sub getlang($)
406{
407  my ($l) = @_;
408  if($l eq "ru_RU") {$l = "ru";}
409  elsif($l eq "pl_PL") {$l = "pl";}
410  return $l;
411}
412
413sub replacemat($$$$)
414{
415  my ($start,$en,$end,$data) = @_;
416  $en = maketxt($en);
417  my $repl = "$start<desCRIPtion locale=\"en\" >".makexml($en)."</desCRIPtion>$end";
418  foreach my $l (sort keys %{$data->{$en}})
419  {
420    next if $l =~ /[._]/;
421    $repl .= "$start<desCRIPtion locale=\"$l\" >".makexml($data->{$en}{$l})."</desCRIPtion>$end";
422  }
423  return $repl;
424}
425
426sub createmat($@)
427{
428  my ($data, @files) = @_;
429
430  foreach my $file (@files)
431  {
432    my $x = $/;
433    undef $/;
434    die "Could not open $file\n" if !open FILE,"<:utf8",$file;
435    my $content = <FILE>;
436    close FILE;
437    foreach my $en (keys %{$data})
438    {
439      my $ostr = qr/( *)<description +locale="en" *>(.*)<\/description>([\r\n]+)(?: *<description .*\/description>[\r\n]+)*/;
440      $content =~ s/$ostr/replacemat($1,$2,$3,$data)/eg;
441    }
442    if($content =~ /(<description .*)/)
443    {
444      die "Could not handle string $1.";
445    }
446
447    $content =~ s/desCRIPtion/description/g;
448
449    die "Could not open output $file\n" if !open FILE,">:utf8",$file;
450    print FILE $content;
451    close FILE;
452  }
453}
454
455sub makenumerus($$$$)
456{
457  my ($data, $first, $last,$l) = @_;
458  my $repl = $first.makexml($data->{$l}).$last;
459  for($i = 1; exists($data->{"$l.$i"}); ++$i)
460  {
461    $repl .= "\n".$first.makexml($data->{"$l.$i"}).$last;
462  }
463  return $repl;
464}
465
466sub convert_ts_message($$$$)
467{
468  my ($content,$data,$l,$ctx) = @_;
469  $content =~ /<source>(.*)<\/source>/s;
470  my $source = ($ctx ? "___${ctx}___" : "") .maketxt($1);
471  if(exists($data->{$source}{$l}))
472  {
473    if($content =~ /numerus="yes"/)
474    {
475      if(!($content =~ s/( +<numerusform>).*(<\/numerusform>)/makenumerus($data->{$source},$1,$2,$l)/se))
476      {
477        die sprintf "Could not replace string '%.10s'",$source;
478      }
479    }
480    else
481    {
482      my $repl = makexml($data->{$source}{$l});
483      if(!($content =~ s/(<translation).*(<\/translation>)/$1>$repl$2/s))
484      {
485        die sprintf "Could not replace string '%.10s'",$source;
486      }
487    }
488  }
489  return $content;
490}
491
492sub convert_ts_context($$$)
493{
494  my ($content,$data,$l) = @_;
495  my $ctx;
496  $ctx = $1 if(!$nocontext && $content =~ /<name>(.*)<\/name>/);
497  $content =~ s/(<message.*?>.*?<\/message>)/convert_ts_message($1,$data,$l,$ctx)/seg;
498  return $content;
499}
500
501sub createts($@)
502{
503  my ($data, @files) = @_;
504
505  foreach my $file (@files)
506  {
507    my $x = $/;
508    undef $/;
509    die "Could not open $file\n" if !open FILE,"<:utf8",$file;
510    my $content = <FILE>;
511    close FILE;
512    if(!($content =~ /<TS .* language="(.*)">/))
513    {
514      die "Could not find language for $file.";
515    }
516    my $l = getlang($1);
517    $content =~ s/(<context>.*?<\/context>)/convert_ts_context($1,$data,$l)/seg;
518
519    die "Could not open output $file\n" if !open FILE,">:utf8",$file;
520    print FILE $content;
521    close FILE;
522  }
523}
524
525sub main
526{
527  my %lang;
528  my @mat;
529  my @po;
530  my @ts;
531  my $basename = shift @ARGV;
532  foreach my $f (@ARGV)
533  {
534    if($f =~ /\*/) { printf "Skipping $f\n"; }
535    elsif($f =~ /\.mat$/) { push(@mat, $f); }
536    elsif($f =~ /\.po$/) { push(@po, $f); }
537    elsif($f =~ /\.ts$/) { push(@ts, $f); }
538    else { die "unknown file extension."; }
539  }
540  my %data = loadfiles(\%lang,\%pokeys, @mat,@ts,@po);
541  my @cpo;
542  foreach my $la (sort keys %lang)
543  {
544    push(@cpo, "${basename}_$la.po");
545  }
546  push(@cpo, "$basename.pot");
547  die "There have been warning. No output.\n" if $waswarn;
548  createpos(\%data, \%pokeys, @cpo);
549
550  createmat(\%data, @mat) if @mat;
551  createts(\%data, @ts) if @ts;
552}
Note: See TracBrowser for help on using the repository browser.