translations/i18n.pl

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