locale/en/locales.pl

   1 #!/usr/bin/perl
   2
   3 # -n do not include custom_ scripts
   4 # -v verbose mode, shows progress stuff
   5
   6 # this version of locles processes not only all required .pl files
   7 # but also all parse_html_templated files.
   8
   9 use Data::Dumper;
  10 use FileHandle;
  11 use Getopt::Long;
  12 use List::Util qw(first);
  13 use POSIX;
  14 use Pod::Usage;
  15
  16 $| = 1;
  17
  18 $basedir  = "../..";
  19 $bindir   = "$basedir/bin/mozilla";
  20 $dbupdir  = "$basedir/sql/Pg-upgrade";
  21 $dbupdir2 = "$basedir/sql/Pg-upgrade2";
  22 $menufile = "menu.ini";
  23 $submitsearch = qr/type\s*=\s*[\"\']?submit/i;
  24
  25 %referenced_html_files = ();
  26
  27 my $opt_v = 0;
  28 my $opt_n = 0;
  29 my $opt_c = 0;
  30
  31 sub parse_args {
  32   my ($help, $man);
  33
  34   GetOptions('no-custom-files' => \$opt_n,
  35              'check-files'     => \$opt_c,
  36              'verbose'         => \$opt_v,
  37              'help'            => \$help,
  38              'man'             => \$man,);
  39
  40   if ($help) {
  41     pod2usage(1);
  42     exit 0;
  43   }
  44
  45   if ($man) {
  46     pod2usage(-exitstatus => 0, -verbose => 2);
  47     exit 0;
  48   }
  49 }
  50
  51 parse_args();
  52
  53 opendir DIR, "$bindir" or die "$!";
  54 @progfiles = grep { /\.pl$/ && !/(_|^\.)/ } readdir DIR;
  55 seekdir DIR, 0;
  56 @customfiles = grep /_/, readdir DIR;
  57 closedir DIR;
  58
  59 # put customized files into @customfiles
  60
  61 if ($opt_n) {
  62   @customfiles = ();
  63   @menufiles   = ($menufile);
  64 } else {
  65   opendir DIR, "$basedir" or die "$!";
  66   @menufiles = grep { /.*?_$menufile$/ } readdir DIR;
  67   closedir DIR;
  68   unshift @menufiles, $menufile;
  69 }
  70
  71 opendir DIR, $dbupdir or die "$!";
  72 @dbplfiles = grep { /\.pl$/ } readdir DIR;
  73 closedir DIR;
  74
  75 opendir DIR, $dbupdir2 or die "$!";
  76 @dbplfiles2 = grep { /\.pl$/ } readdir DIR;
  77 closedir DIR;
  78
  79 # slurp the translations in
  80 if (-f 'all') {
  81   require "all";
  82 }
  83
  84 my %old_texts = %{ $self->{texts} };
  85
  86 # Read HTML templates.
  87 #%htmllocale = ();
  88 #@htmltemplates = <../../templates/webpages/*/*_master.html>;
  89 #foreach $file (@htmltemplates) {
  90 #  scanhtmlfile($file);
  91 #}
  92
  93 map({ handle_file($_, $bindir); } @progfiles);
  94 map({ handle_file($_, $dbupdir); } @dbplfiles);
  95 map({ handle_file($_, $dbupdir2); } @dbplfiles2);
  96
  97 sub handle_file {
  98   my ($file, $dir) = @_;
  99   print "\n$file" if $opt_v;
 100   %locale = ();
 101   %submit = ();
 102   %subrt  = ();
 103
 104   &scanfile("$dir/$file");
 105
 106   # scan custom_{module}.pl or {login}_{module}.pl files
 107   foreach $customfile (@customfiles) {
 108     if ($customfile =~ /_$file/) {
 109       if (-f "$dir/$customfile") {
 110         &scanfile("$dir/$customfile");
 111       }
 112     }
 113   }
 114
 115   # if this is the menu.pl file
 116   if ($file eq 'menu.pl') {
 117     foreach $item (@menufiles) {
 118       &scanmenu("$basedir/$item");
 119     }
 120   }
 121
 122   if ($file eq 'menunew.pl') {
 123     foreach $item (@menufiles) {
 124       &scanmenu("$basedir/$item");
 125       print "." if $opt_v;
 126     }
 127   }
 128
 129   $file =~ s/\.pl//;
 130
 131   eval { require 'missing'; };
 132   unlink 'missing';
 133
 134   foreach $text (keys %$missing) {
 135     if ($locale{$text} || $htmllocale{$text}) {
 136       unless ($self->{texts}{$text}) {
 137         $self->{texts}{$text} = $missing->{$text};
 138       }
 139     }
 140   }
 141
 142   open FH, ">$file" or die "$! : $file";
 143
 144   print FH q|#!/usr/bin/perl
 145
 146 $self->{texts} = {
 147 |;
 148
 149   foreach $key (sort keys %locale) {
 150     if ($self->{texts}{$key}) {
 151       $text = $self->{texts}{$key};
 152     } else {
 153       $text = $key;
 154     }
 155     $text =~ s/'/\\'/g;
 156     $text =~ s/\\$/\\\\/;
 157
 158     $keytext = $key;
 159     $keytext =~ s/'/\\'/g;
 160     $keytext =~ s/\\$/\\\\/;
 161
 162     print FH qq|  '$keytext'|
 163       . (' ' x (27 - length($keytext)))
 164       . qq| => '$text',\n|;
 165   }
 166
 167   print FH q|};
 168
 169 $self->{subs} = {
 170 |;
 171
 172   foreach $key (sort keys %subrt) {
 173     $text = $key;
 174     $text =~ s/'/\\'/g;
 175     $text =~ s/\\$/\\\\/;
 176     print FH qq|  '$text'| . (' ' x (27 - length($text))) . qq| => '$text',\n|;
 177   }
 178
 179   foreach $key (sort keys %submit) {
 180     $text = ($self->{texts}{$key}) ? $self->{texts}{$key} : $key;
 181     $text =~ s/'/\\'/g;
 182     $text =~ s/\\$/\\\\/;
 183
 184     $english_sub = $key;
 185     $english_sub =~ s/'/\\'/g;
 186     $english_sub =~ s/\\$/\\\\/;
 187     $english_sub = lc $key;
 188
 189     $translated_sub = lc $text;
 190     $english_sub    =~ s/( |-|,)/_/g;
 191     $translated_sub =~ s/( |-|,)/_/g;
 192     print FH qq|  '$translated_sub'|
 193       . (' ' x (27 - length($translated_sub)))
 194       . qq| => '$english_sub',\n|;
 195   }
 196
 197   print FH q|};
 198
 199 1;
 200 |;
 201
 202   close FH;
 203
 204 }
 205
 206 #foreach $file (@htmltemplates) {
 207 #  converthtmlfile($file);
 208 #}
 209
 210 # now print out all
 211
 212 open FH, ">all" or die "$! : all";
 213
 214 print FH q|#!/usr/bin/perl
 215
 216 # These are all the texts to build the translations files.
 217 # The file has the form of 'english text'  => 'foreign text',
 218 # you can add the translation in this file or in the 'missing' file
 219 # run locales.pl from this directory to rebuild the translation files
 220
 221 $self->{texts} = {
 222 |;
 223
 224 foreach $key (sort keys %alllocales) {
 225   $text = $self->{texts}{$key};
 226
 227   $count++;
 228
 229   $text =~ s/'/\\'/g;
 230   $text =~ s/\\$/\\\\/;
 231   $key  =~ s/'/\\'/g;
 232   $key  =~ s/\\$/\\\\/;
 233
 234   unless ($text) {
 235     $notext++;
 236     push @missing, $key;
 237   }
 238
 239   print FH qq|  '$key'| . (' ' x (27 - length($key))) . qq| => '$text',\n|;
 240
 241 }
 242
 243 print FH q|};
 244
 245 1;
 246 |;
 247
 248 close FH;
 249
 250 if (@missing) {
 251   open FH, ">missing" or die "$! : missing";
 252
 253   print FH q|#!/usr/bin/perl
 254
 255 # add the missing texts and run locales.pl to rebuild
 256
 257 $missing = {
 258 |;
 259
 260   foreach $text (@missing) {
 261     print FH qq|  '$text'| . (' ' x (27 - length($text))) . qq| => '',\n|;
 262   }
 263
 264   print FH q|};
 265
 266 1;
 267 |;
 268
 269   close FH;
 270
 271 }
 272
 273 @lost = ();
 274
 275 if (-f "lost") {
 276   require "lost";
 277   unlink "lost";
 278 }
 279
 280 while (($text, $translation) = each %old_texts) {
 281   next if ($alllocales{$text});
 282
 283   push @lost, { 'text' => $text, 'translation' => $translation };
 284 }
 285
 286 if (scalar @lost) {
 287   splice @lost, 0, (scalar @lost - 50) if (scalar @lost > 50);
 288
 289   open FH, ">lost";
 290   print FH "#!/usr/bin/perl\n\n" .
 291     "# The last 50 texts that have been removed.\n" .
 292     "# This file will be auto-generated by locales.pl. Do not edit it.\n\n" .
 293     "\@lost = (\n";
 294
 295   foreach $entry (@lost) {
 296     $entry->{text}        =~ s/\'/\\\'/g;
 297     $entry->{translation} =~ s/\'/\\\'/g;
 298     print FH "  { 'text' => '$entry->{text}', 'translation' => '$entry->{translation}' },\n";
 299   }
 300
 301   print FH ");\n\n1;\n";
 302   close FH;
 303 }
 304
 305 open(FH, "LANGUAGE");
 306 @language = <FH>;
 307 close(FH);
 308 $trlanguage = $language[0];
 309 chomp $trlanguage;
 310
 311 if ($opt_c) {
 312   search_unused_htmlfiles();
 313   search_translated_htmlfiles_wo_master();
 314 }
 315
 316 $per = sprintf("%.1f", ($count - $notext) / $count * 100);
 317 print "\n$trlanguage - ${per}%";
 318 print " - $notext/$count missing" if $notext;
 319 print "\n";
 320
 321 exit;
 322
 323 # eom
 324
 325 sub extract_text_between_parenthesis {
 326   my ($fh, $line) = @_;
 327   my ($inside_string, $pos, $text, $quote_next) = (undef, 0, "", 0);
 328
 329   while (1) {
 330     if (length($line) <= $pos) {
 331       $line = <$fh>;
 332       return ($text, "") unless ($line);
 333       $pos = 0;
 334     }
 335
 336     my $cur_char = substr($line, $pos, 1);
 337
 338     if (!$inside_string) {
 339       if ((length($line) >= ($pos + 3)) && (substr($line, $pos, 2)) eq "qq") {
 340         $inside_string = substr($line, $pos + 2, 1);
 341         $pos += 2;
 342
 343       } elsif ((length($line) >= ($pos + 2)) &&
 344                (substr($line, $pos, 1) eq "q")) {
 345         $inside_string = substr($line, $pos + 1, 1);
 346         $pos++;
 347
 348       } elsif (($cur_char eq '"') || ($cur_char eq '\'')) {
 349         $inside_string = $cur_char;
 350
 351       } elsif (($cur_char eq ")") || ($cur_char eq ',')) {
 352         return ($text, substr($line, $pos + 1));
 353       }
 354
 355     } else {
 356       if ($quote_next) {
 357         $text .= $cur_char;
 358         $quote_next = 0;
 359
 360       } elsif ($cur_char eq '\\') {
 361         $text .= $cur_char;
 362         $quote_next = 1;
 363
 364       } elsif ($cur_char eq $inside_string) {
 365         undef($inside_string);
 366
 367       } else {
 368         $text .= $cur_char;
 369
 370       }
 371     }
 372     $pos++;
 373   }
 374 }
 375
 376 sub scanfile {
 377   my $file = shift;
 378   my $dont_include_subs = shift;
 379   my $scanned_files = shift;
 380
 381   # sanitize file
 382   $file =~ s=/+=/=g;
 383
 384   $scanned_files = {} unless ($scanned_files);
 385   return if ($scanned_files->{$file});
 386   $scanned_files->{$file} = 1;
 387
 388   if (!defined $cached{$file}) {
 389
 390     return unless (-f "$file");
 391
 392     my $fh = new FileHandle;
 393     open $fh, "$file" or die "$! : $file";
 394
 395     my ($is_submit, $line_no, $sub_line_no) = (0, 0, 0);
 396
 397     while (<$fh>) {
 398       $line_no++;
 399
 400       # is this another file
 401       if (/require\s+\W.*\.pl/) {
 402         my $newfile = $&;
 403         $newfile =~ s/require\s+\W//;
 404         $newfile =~ s|bin/mozilla||;
 405 #         &scanfile("$bindir/$newfile", 0, $scanned_files);
 406          $cached{$file}{scan}{"$bindir/$newfile"} = 1;
 407       } elsif (/use\s+SL::(.*?);/) {
 408         my $module =  $1;
 409         $module    =~ s|::|/|g;
 410 #         &scanfile("../../SL/${1}.pm", 1, $scanned_files);
 411         $cached{$file}{scannosubs}{"../../SL/${module}.pm"} = 1;
 412       }
 413
 414       # is this a template call?
 415       if (/parse_html_template2?\s*\(\s*[\"\']([\w\/]+)\s*[\"\']/) {
 416         my $newfile = "$basedir/templates/webpages/$1_master.html";
 417         if (/parse_html_template2/) {
 418           print "E: " . strip_base($file) . " is still using 'parse_html_template2' for " . strip_base($newfile) . ".\n";
 419         }
 420         if (-f $newfile) {
 421 #           &scanhtmlfile($newfile);
 422 #           &converthtmlfile($newfile);
 423            $cached{$file}{scanh}{$newfile} = 1;
 424           print "." if $opt_v;
 425         } elsif ($opt_c) {
 426           print "W: missing HTML template: " . strip_base($newfile) . " (referenced from " . strip_base($file) . ")\n";
 427         }
 428       }
 429
 430       # is this a sub ?
 431       if (/^sub /) {
 432         next if ($dont_include_subs);
 433         ($null, $subrt) = split / +/;
 434 #        $subrt{$subrt} = 1;
 435         $cached{$file}{subr}{$subrt} = 1;
 436         next;
 437       }
 438
 439       my $rc = 1;
 440
 441       while ($rc) {
 442         if (/Locale/) {
 443           unless (/^use /) {
 444             my ($null, $country) = split /,/;
 445             $country =~ s/^ +[\"\']//;
 446             $country =~ s/[\"\'].*//;
 447           }
 448         }
 449
 450         my $postmatch = "";
 451
 452         # is it a submit button before $locale->
 453         if (/$submitsearch/) {
 454           $postmatch = "$'";
 455           if ($` !~ /locale->text/) {
 456             $is_submit   = 1;
 457             $sub_line_no = $line_no;
 458           }
 459         }
 460
 461         my ($found) = /locale->text.*?\(/;
 462         my $postmatch = "$'";
 463
 464         if ($found) {
 465           my $string;
 466           ($string, $_) = extract_text_between_parenthesis($fh, $postmatch);
 467           $postmatch = $_;
 468
 469           # if there is no $ in the string record it
 470           unless (($string =~ /\$\D.*/) || ("" eq $string)) {
 471
 472             # this guarantees one instance of string
 473 #            $locale{$string} = 1;
 474             $cached{$file}{locale}{$string} = 1;
 475
 476             # this one is for all the locales
 477 #            $alllocales{$string} = 1;
 478             $cached{$file}{all}{$string} = 1;
 479
 480             # is it a submit button before $locale->
 481             if ($is_submit) {
 482 #              $submit{$string} = 1;
 483               $cached{$file}{submit}{$string} = 1;
 484             }
 485           }
 486         } elsif ($postmatch =~ />/) {
 487           $is_submit = 0;
 488         }
 489
 490         # exit loop if there are no more locales on this line
 491         ($rc) = ($postmatch =~ /locale->text/);
 492
 493         if (   ($postmatch =~ />/)
 494             || (!$found && ($sub_line_no != $line_no) && />/)) {
 495           $is_submit = 0;
 496         }
 497       }
 498     }
 499
 500     close($fh);
 501
 502   }
 503
 504   map { $alllocales{$_} = 1 }   keys %{$cached{$file}{all}};
 505   map { $locale{$_} = 1 }       keys %{$cached{$file}{locale}};
 506   map { $submit{$_} = 1 }       keys %{$cached{$file}{submit}};
 507   map { $subrt{$_} = 1 }        keys %{$cached{$file}{subr}};
 508   map { &scanfile($_, 0, $scanned_files) } keys %{$cached{$file}{scan}};
 509   map { &scanfile($_, 1, $scanned_files) } keys %{$cached{$file}{scannosubs}};
 510   map { &scanhtmlfile($_)  }    keys %{$cached{$file}{scanh}};
 511
 512   @referenced_html_files{keys %{$cached{$file}{scanh}}} = (1) x scalar keys %{$cached{$file}{scanh}};
 513 }
 514
 515 sub scanmenu {
 516   my $file = shift;
 517
 518   my $fh = new FileHandle;
 519   open $fh, "$file" or die "$! : $file";
 520
 521   my @a = grep m/^\[/, <$fh>;
 522   close($fh);
 523
 524   # strip []
 525   grep { s/(\[|\])//g } @a;
 526
 527   foreach my $item (@a) {
 528     @b = split /--/, $item;
 529     foreach $string (@b) {
 530       chomp $string;
 531       $locale{$string}     = 1;
 532       $alllocales{$string} = 1;
 533     }
 534   }
 535
 536 }
 537
 538 sub scanhtmlfile {
 539   local *IN;
 540
 541   if (!defined $cached{$_[0]}) {
 542     my %plugins = ( 'loaded' => { }, 'needed' => { } );
 543
 544     open(IN, $_[0]) || die $_[0];
 545
 546     my $copying = 0;
 547     my $issubmit = 0;
 548     my $text = "";
 549     while (my $line = <IN>) {
 550       chomp($line);
 551
 552       while ($line =~ m/\[\%[^\w]*use[^\w]+(\w+)[^\w]*?\%\]/gi) {
 553         $plugins{loaded}->{$1} = 1;
 554       }
 555
 556       while ($line =~ m/\[\%[^\w]*(\w+)\.\w+\(/g) {
 557         my $plugin = $1;
 558         $plugins{needed}->{$plugin} = 1 if (first { $_ eq $plugin } qw(HTML LxERP JavaScript MultiColumnIterator));
 559       }
 560
 561       while ("" ne $line) {
 562         if (!$copying) {
 563           if ($line =~ m|<translate>|i) {
 564             my $eom = $+[0];
 565             if ($` =~ /$submitsearch/) {
 566               $issubmit = 1
 567             }
 568             substr($line, 0, $eom) = "";
 569             $copying = 1;
 570           } else {
 571             $line = "";
 572           }
 573
 574         } else {
 575           if ($line =~ m|</translate>|i) {
 576             $text .= $`;
 577             substr($line, 0, $+[0]) = "";
 578             $text =~ s/\s+/ /g;
 579
 580             $copying = 0;
 581             if ($issubmit) {
 582   #            $submit{$text} = 1;
 583                $cached{$_[0]}{submit}{$text} = 1;
 584               $issubmit = 0;
 585             }
 586   #          $alllocales{$text} = 1;
 587              $cached{$_[0]}{all}{$text} = 1;
 588   #          $htmllocale{$text} = 1;
 589              $cached{$_[0]}{html}{$text} = 1;
 590             $text = "";
 591
 592           } else {
 593             $text .= $line;
 594             $line = "";
 595           }
 596         }
 597       }
 598     }
 599
 600     close(IN);
 601
 602     foreach my $plugin (keys %{ $plugins{needed} }) {
 603       next if ($plugins{loaded}->{$plugin});
 604       print "E: " . strip_base($_[0]) . " requires the Template plugin '$plugin', but is not loaded with '[\% USE $plugin \%]'.\n";
 605     }
 606
 607     &converthtmlfile($_[0]);
 608   }
 609
 610   # copy back into global arrays
 611   map { $alllocales{$_} = 1 }  keys %{$cached{$_[0]}{all}};
 612   map { $htmllocales{$_} = 1 } keys %{$cached{$_[0]}{html}};
 613   map { $submit{$_} = 1 }      keys %{$cached{$_[0]}{submit}};
 614 }
 615
 616 sub converthtmlfile {
 617   local *IN;
 618   local *OUT;
 619
 620   my $file = shift;
 621
 622   open(IN, $file) || die;
 623
 624   my $langcode = (split("/", getcwd()))[-1];
 625   $file =~ s/_master.html$/_${langcode}.html/;
 626
 627   open(OUT, ">$file") || die;
 628
 629   my $copying = 0;
 630   my $text = "";
 631   while (my $line = <IN>) {
 632     chomp($line);
 633     if ("" eq $line) {
 634       print(OUT "\n");
 635       next;
 636     }
 637
 638     while ("" ne $line) {
 639       if (!$copying) {
 640         if ($line =~ m|<translate>|i) {
 641           print(OUT $`);
 642           substr($line, 0, $+[0]) = "";
 643           $copying = 1;
 644           print(OUT "\n") if ("" eq $line);
 645
 646         } else {
 647           print(OUT "${line}\n");
 648           $line = "";
 649         }
 650
 651       } else {
 652         if ($line =~ m|</translate>|i) {
 653           $text .= $`;
 654           substr($line, 0, $+[0]) = "";
 655           $text =~ s/\s+/ /g;
 656           $copying = 0;
 657           $alllocales{$text} = 1;
 658           $htmllocale{$text} = 1;
 659           print(OUT $self->{"texts"}{$text} || $text);
 660           print(OUT "\n") if ("" eq $line);
 661           $text = "";
 662
 663         } else {
 664           $text .= $line;
 665           $line = "";
 666         }
 667       }
 668     }
 669   }
 670
 671   close(IN);
 672   close(OUT);
 673 }
 674
 675 sub search_unused_htmlfiles {
 676   my @unscanned_dirs = ('../../templates/webpages');
 677
 678   while (scalar @unscanned_dirs) {
 679     my $dir = shift @unscanned_dirs;
 680
 681     foreach my $entry (<$dir/*>) {
 682       if (-d $entry) {
 683         push @unscanned_dirs, $entry;
 684
 685       } elsif (($entry =~ /_master.html$/) && -f $entry && !$referenced_html_files{$entry}) {
 686         print "W: unused HTML template: " . strip_base($entry) . "\n";
 687
 688       }
 689     }
 690   }
 691 }
 692
 693 sub search_translated_htmlfiles_wo_master {
 694   my @unscanned_dirs = ('../../templates/webpages');
 695
 696   while (scalar @unscanned_dirs) {
 697     my $dir = shift @unscanned_dirs;
 698
 699     foreach my $entry (<$dir/*>) {
 700       if (-d $entry) {
 701         push @unscanned_dirs, $entry;
 702
 703       } elsif (($entry =~ /_[a-z]+\.html$/) && ($entry !~ /_master.html$/) && -f $entry) {
 704         my $master =  $entry;
 705         $master    =~ s/[a-z]+\.html$/master.html/;
 706         if (! -f $master) {
 707           print "W: translated HTML template without master: " . strip_base($entry) . "\n";
 708         }
 709       }
 710     }
 711   }
 712 }
 713
 714 sub strip_base {
 715   my $s =  "$_[0]";             # Create a copy of the string.
 716
 717   $s    =~ s|^../../||;
 718   $s    =~ s|templates/webpages/||;
 719
 720   return $s;
 721 }
 722
 723 __END__
 724
 725 =head1 NAME
 726
 727 locales.pl - Collect strings for translation in Lx-Office
 728
 729 =head1 SYNOPSIS
 730
 731 locales.pl [options]
 732
 733  Options:
 734   -n, --no-custom-files  Do not process files whose name contains "_"
 735   -c, --check-files      Run extended checks on HTML files
 736   -v, --verbose          Be more verbose
 737   -h, --help             Show this help
 738
 739 =head1 OPTIONS
 740
 741 =over 8
 742
 743 =item B<-n>, B<--no-custom-files>
 744
 745 Do not process files whose name contains "_", e.g. "custom_io.pl".
 746
 747 =item B<-c>, B<--check-files>
 748
 749 Run extended checks on the usage of templates. This can be used to
 750 discover HTML templates that are never used as well as the usage of
 751 non-existing HTML templates.
 752
 753 =item B<-v>, B<--verbose>
 754
 755 Be more verbose.
 756
 757 =back
 758
 759 =head1 DESCRIPTION
 760
 761 This script collects strings from Perl files, the menu.ini file and
 762 HTML templates and puts them into the file "all" for translation.  It
 763 also distributes those translations back to the individual files.
 764
 765 =cut