development/checkurls/getTranslators.pl

   1 #! /usr/bin/env perl
   2 # -*- mode: perl; -*-
   3
   4 # file getTranslators.pl
   5 # This file is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public
   7 # License as published by the Free Software Foundation; either
   8 # version 2 of the License, or (at your option) any later version.
   9 #
  10 # This software is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public
  16 # License along with this software; if not, write to the Free Software
  17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 #
  19 # Copyright (c) 2015 Kornel Benko <kornel@lyx.org>
  20
  21 use strict;
  22
  23 package IdentityParse;
  24 use base "HTML::Parser";
  25 use locale;
  26 use POSIX qw(locale_h);
  27 use feature 'fc';
  28
  29 setlocale(LC_CTYPE, "");
  30 setlocale(LC_MESSAGES, "en_US.UTF-8");
  31 $ENV{LC_ALL} = "C";             # set language for the output of command 'msgfmt'
  32
  33 # Prototypes
  34 sub insertEntry(\%$$);
  35 sub start($$$$$);
  36 sub text($$);
  37 sub end($$$);
  38 sub actual_tag();
  39 sub convertlang($);
  40 sub scanPoFile($);
  41 sub row_init(\%);
  42 sub row_valid(\%);
  43 sub phantomscript();
  44
  45 my $p = new IdentityParse;
  46 $p->strict_names(0);
  47
  48 my $lyxurl = "http://www.lyx.org/I18n-trunk";
  49 my $podir = "./po";     # script starts in top binary dir
  50 my $jsfile = "$podir/lyxtranslators.js";
  51
  52 my %langs = (                   # translation to make language spec unique
  53   "pt" => "Portuguese",
  54   "pt_BR" => "Portuguese (Brazilian)",
  55   "ar" => "Arabic",
  56   "bg" => "Bulgarian",
  57   "ca" => "Catalan",
  58   "cs" => "Czech",
  59   "da" => "Danish",
  60   "de" => "German",
  61   "el" => "Greek",
  62   "en" => "English",
  63   "es" => "Spanish",
  64   "eu" => "Basque",
  65   "fi" => "Finnish",
  66   "fr" => "French",
  67   "gl" => "Galician",
  68   "he" => "Hebrew",
  69   "hu" => "Hungarian",
  70   "ia" => "Interlingua",
  71   "id" => "Indonesian",
  72   "it" => "Italian",
  73   "ja" => "Japanese",
  74   "ko" => "Korean",
  75   "sk" => "Slovak",
  76   "nb" => "Norwegian (Bokmål)",
  77   "nl" => "Dutch",
  78   "nn" => "Norwegian (Nynorsk)",
  79   "pl" => "Polish",
  80   "ro" => "Romanian",
  81   "ru" => "Russian",
  82   "sr" => "Serbian",
  83   "sv" => "Swedish",
  84   "tr" => "Turkish",
  85   "uk" => "Ukrainian",
  86   "zh_CN" => "Chinese (simplified)",
  87   "zh_TW" => "Chinese (traditional)",
  88   "Simplified" => "Chinese (simplified)",
  89   "Simplified Chinese" => "Chinese (simplified)",
  90   "Traditional Chinese" => "Chinese (traditional)",
  91     );
  92
  93 open(FO, '>', "$jsfile");
  94 print FO &phantomscript();
  95 close(FO);
  96
  97 my %status = ();
  98 my @tag = ();                   # stack for active html-tags
  99 my %page_row = ();                      # entries for mail, name pofile, language (in the actual row or po-file)
 100 my @translation_entries = qw(language mail name pofile);
 101
 102 my %list = ();                  # collected list of rows, entry key is language
 103
 104 my $errors = 0;
 105 if (open(my $fh, "phantomjs $jsfile|")) {
 106   $p->parse_file($fh);
 107   print "Parsed \"$lyxurl\"\n";
 108 }
 109 else {
 110   $errors++;    # cannot parse html file
 111   print "ERROR: Program \"phantomjs\" to parse \"$lyxurl\" could not be executed\n";
 112 }
 113
 114 if (opendir(DI, $podir)) {
 115   my $po_count = 0;
 116   while (my $po = readdir(DI)) {
 117     if ($po =~ /\.po$/) {
 118       my $res = &scanPoFile("$po");
 119       if ($res == 0) {
 120         print "No valid entry found in \"$po\"\n";
 121         $errors++;
 122       }
 123       else {
 124         $po_count += $res;
 125       }
 126     }
 127   }
 128   closedir(DI);
 129   if ($po_count < 1) {
 130     print "ERROR: No correct po-files in directory \"$podir\" found\n";
 131     $errors++;
 132   }
 133   else {
 134     print "Found $po_count po-files with valid translator entry\n";
 135   }
 136 }
 137 else {
 138   print "Directory for po-files ($podir) missing\n";
 139   $errors++;    # PO directory not found, so cannot check
 140 }
 141
 142 for my $lang (sort keys %list) {
 143   for my $rentry (@{$list{$lang}}) {
 144     my $prefix = sprintf("(%03d%) ", "$rentry->{fract}");
 145     if (defined($rentry->{error})) {
 146       $errors++;
 147       $prefix .= sprintf("%-24s", "$rentry->{error}:");
 148     }
 149     else {
 150       $prefix .= sprintf("%24s", "");
 151     }
 152     my $msg = sprintf("%-24s%-10s", "$lang:", "$rentry->{po},");
 153     print "$prefix$msg mail = \"$rentry->{name}\" <$rentry->{mail}>\n";
 154   }
 155 }
 156
 157 if ($errors > 0) {
 158   exit(1);
 159 }
 160 else {
 161   exit(0);
 162 }
 163 ###################################################################
 164 # Insert collected row values in %list
 165 sub insertEntry(\%$$)
 166 {
 167   my ($rrow, $cycle, $fract) = @_;
 168
 169   # Convert mangled mail
 170   $rrow->{mail} =~ s/ pound /\@/;
 171   $rrow->{mail} =~ s/ dot /\./g;
 172   $rrow->{mail} =~ s/ underscore /_/g;
 173   my %entry = ();
 174   my $language = $rrow->{language};
 175   $entry{mail} = $rrow->{mail};
 176   $entry{name} = $rrow->{name};
 177   $entry{po} = $rrow->{pofile};
 178   $entry{cycle} = $cycle;
 179   # Check, if entry already exists
 180   if (! defined($list{$language})) {
 181     $list{$language} = [];
 182   }
 183   my $found = 0;
 184   my $empty = 1;
 185   my $name1 = undef;
 186   for my $rentry (@{$list{$language}}) {
 187     $empty = 0;
 188     if ($cycle == 2) {
 189       if (! defined($rentry->{fract})) {
 190         $rentry->{fract} = $fract;
 191       }
 192     }
 193     next if (fc($rentry->{mail}) ne fc($rrow->{mail})); # char case does not matter in mail strings
 194     next if ($rentry->{po} ne $rrow->{pofile});
 195     $name1 = $rentry->{name};
 196     $found = 1;
 197     last;
 198   }
 199   if ($cycle == 1) {
 200     push(@{$list{$language}}, \%entry);
 201   }
 202   else {
 203     $entry{fract} = $fract;
 204     if ($empty) {
 205       if ($fract > 40) {
 206         $entry{error} = "Missing in page";
 207         push(@{$list{$language}}, \%entry);
 208       }
 209     }
 210     elsif (! $found) {
 211       $entry{error} = "Different mail in po";
 212       push(@{$list{$language}}, \%entry);
 213     }
 214     else {
 215       # found, but maybe incorrect name?
 216       if ($name1 ne $rrow->{name}) {
 217         $entry{error} = "Different name in po";
 218         push(@{$list{$language}}, \%entry);
 219       }
 220     }
 221   }
 222 }
 223
 224 #######################################################################
 225 # Routines called from parse_file(): start(), text(), end().
 226 sub start($$$$$)
 227 {
 228   my ($self, $tag, $attr, $attrseq, $origtext) = @_;
 229
 230   push(@tag, $tag);
 231   if ($tag eq "tr") {           # new table row
 232     &row_init(\%page_row);
 233     for my $k (keys %status) {
 234       $status{$k} = 0;
 235     }
 236   }
 237   $status{"Tag_" . $tag} =  $status{"Tag_" . $tag} + 1;
 238
 239   if ($tag eq "a") {
 240     if (defined($attr->{class})) {
 241       if ($attr->{class} eq "urllink") {
 242         if ($status{Tag_td} == 6) {
 243           if ($attr->{href} =~ /^mailto:(.*)$/) {
 244             $page_row{mail} = $1;
 245             $page_row{mail} =~ s/\%20/ /g;
 246           }
 247         }
 248         elsif ($status{Tag_td} == 1) {
 249           if ($attr->{href} =~ /f=po\/([a-z][a-z](_[A-Z][A-Z])?\.po)$/) {
 250             $page_row{pofile} = $1;
 251           }
 252         }
 253       }
 254     }
 255   }
 256 }
 257
 258 sub text($$)
 259 {
 260   my ($self, $text) = @_;
 261
 262   if ($status{Tag_td} == 1) {
 263     if (&actual_tag() eq "a") {
 264       if ($text =~ /^[A-Z][a-z]+( .+)?$/) {
 265         $page_row{language} = &convertlang($text);
 266       }
 267     }
 268   }
 269   if ($status{Tag_td} == 6) {
 270     if (&actual_tag() eq "a") {
 271       $page_row{name} .= $text; # '.=' because text can be splitted
 272     }
 273     elsif (&actual_tag() eq "td") { # name without associated e-mail
 274       $page_row{name} .= $text;
 275     }
 276   }
 277 }
 278
 279 sub end($$$)
 280 {
 281   my ($self, $tag, $origtext) = @_;
 282
 283   while (my $t = pop(@tag)) {
 284     last if ($t eq $tag);
 285   }
 286   if ($tag eq "tr") {
 287     # check row entry for completeness
 288     return if (! &row_valid(\%page_row));
 289     &insertEntry(\%page_row, 1);
 290   }
 291 }
 292
 293 sub actual_tag()
 294 {
 295   return undef if (@tag == 0);
 296   return($tag[$#tag]);
 297 }
 298
 299 sub convertlang($)
 300 {
 301   my ($ilang) = @_;
 302   $ilang =~ s/\s+$//;
 303   if (defined($langs{$ilang})) {
 304     return($langs{$ilang});
 305   }
 306   else {
 307     return($ilang);
 308   }
 309 }
 310
 311 sub scanPoFile($)
 312 {
 313   my ($pofile) = @_;
 314   my %po_row;
 315   my ($translated, $fuzzy, $untranslated) = (0, 0, 0);
 316
 317   if (open(FM, "msgfmt -c --statistics $podir/$pofile 2>&1 |")) {
 318     while (my $l = <FM>) {
 319       if ($l =~ s/^(\d+)\s+translated messages.\s*//) {
 320         $translated = $1;
 321       }
 322       if ($l =~ s/^(\d+)\s+fuzzy translations.\s*//) {
 323         $fuzzy = $1;
 324       }
 325       if ($l =~ s/^(\d+)\s+untranslated messages//) {
 326         $untranslated = $1;
 327       }
 328     }
 329     close(FM);
 330   }
 331   return 0 if ($translated == 0);
 332   my $fract = int(($translated * 100)/($translated+$fuzzy+$untranslated));
 333   if (open(FI, "$podir/$pofile")) {
 334     &row_init(\%po_row);
 335     $po_row{pofile} = $pofile;
 336     my $i = 0;
 337     while (my $l = <FI>) {
 338       last if ($l =~ /^"[A-Z].*:/);
 339     }
 340     my $inserted = 0;
 341     while (my $l = <FI>) {
 342       last if ($l !~ /^"/);
 343       chomp($l);
 344       if ($l =~ s/^"Last-Translator:\s//) {
 345         while ($l !~ />\\n"$/) {
 346           $l =~ s/"$//;
 347           my $extraline = <FI>;
 348           chomp($extraline);
 349           $extraline =~ s/^"//;
 350           $l .= $extraline
 351         }
 352         if ($l =~ /^([^<]*)<([^>]*)>/) {        # allow empty mail
 353           $po_row{mail} = $2;
 354           ($po_row{name} = $1) =~ s/\s+$//;
 355           $i += 2;
 356         }
 357       }
 358       elsif ($l =~/^"Language:\s*([^\\]+)\\n/) {
 359         $po_row{language} = &convertlang($1);
 360         $i += 1;
 361       }
 362       if (&row_valid(\%po_row)) {
 363         &insertEntry(\%po_row, 2, $fract);
 364         $inserted++;
 365         last;
 366       }
 367     }
 368     close(FI);
 369     return($inserted);
 370   }
 371   else {
 372     return(0);
 373   }
 374 }
 375
 376 ###########################################################
 377 # handling of row entries
 378
 379 sub row_init(\%)
 380 {
 381   my ($rrow) = @_;
 382   %{$rrow} = ();
 383   $rrow->{mail} = "";           # Allow for empty mail
 384 }
 385
 386 sub row_valid(\%)
 387 {
 388   my ($rrow) = @_;
 389   for my $k (@translation_entries) {
 390     return 0 if (! defined($rrow->{$k}));
 391   }
 392   return(1);
 393 }
 394
 395 # used by phantomjs command to output the refered html page
 396 sub phantomscript()
 397 {
 398   return "var page = require(\"webpage\").create();
 399 var url = \"$lyxurl\";
 400 page.open(url,
 401  function (status) {
 402   var f = function () {
 403    var html = page.evaluate(function () { return document.documentElement.innerHTML });
 404    console.log(html);
 405    phantom.exit();
 406   };
 407   setTimeout(f, 5000);
 408  }
 409 );
 410 ";
 411 }