scripts/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 utf8;
  10 use strict;
  11
  12 use Data::Dumper;
  13 use English;
  14 use FileHandle;
  15 use Getopt::Long;
  16 use List::Util qw(first);
  17 use POSIX;
  18 use Pod::Usage;
  19 use Carp;
  20 use File::Slurp qw(slurp);
  21
  22 $OUTPUT_AUTOFLUSH = 1;
  23
  24 my $opt_v  = 0;
  25 my $opt_n  = 0;
  26 my $opt_c  = 0;
  27 my $debug  = 0;
  28
  29 parse_args();
  30
  31 my $basedir      = "../..";
  32 my $locales_dir  = ".";
  33 my $bindir       = "$basedir/bin/mozilla";
  34 my $dbupdir      = "$basedir/sql/Pg-upgrade";
  35 my $dbupdir2     = "$basedir/sql/Pg-upgrade2";
  36 my $menufile     = "menu.ini";
  37 my $submitsearch = qr/type\s*=\s*[\"\']?submit/i;
  38
  39 my (%referenced_html_files, %locale, %htmllocale, %alllocales, %cached, %submit);
  40 my ($ALL_HEADER, $MISSING_HEADER, $LOST_HEADER);
  41
  42 init();
  43
  44 opendir DIR, "$bindir" or die "$!";
  45 my @progfiles = grep { /\.pl$/ && !/(_custom|^\.)/ } readdir DIR;
  46 seekdir DIR, 0;
  47 my @customfiles = grep /_custom/, readdir DIR;
  48 closedir DIR;
  49
  50 # put customized files into @customfiles
  51 my @menufiles;
  52
  53 if ($opt_n) {
  54   @customfiles = ();
  55   @menufiles   = ($menufile);
  56 } else {
  57   opendir DIR, "$basedir" or die "$!";
  58   @menufiles = grep { /.*?_$menufile$/ } readdir DIR;
  59   closedir DIR;
  60   unshift @menufiles, $menufile;
  61 }
  62
  63 opendir DIR, $dbupdir or die "$!";
  64 my @dbplfiles = grep { /\.pl$/ } readdir DIR;
  65 closedir DIR;
  66
  67 opendir DIR, $dbupdir2 or die "$!";
  68 my @dbplfiles2 = grep { /\.pl$/ } readdir DIR;
  69 closedir DIR;
  70
  71 # slurp the translations in
  72 our $self    = {};
  73 our $missing = {};
  74 our @missing = ();
  75 our @lost    = ();
  76
  77 if (-f "$locales_dir/all") {
  78   require "$locales_dir/all";
  79 }
  80 if (-f "$locales_dir/missing") {
  81   require "$locales_dir/missing" ;
  82   unlink "$locales_dir/missing";
  83 }
  84 if (-f "$locales_dir/lost") {
  85   require "$locales_dir/lost";
  86   unlink "$locales_dir/lost";
  87 }
  88
  89 my $charset = slurp("$locales_dir/charset") || 'utf-8';
  90 chomp $charset;
  91
  92 my %old_texts = %{ $self->{texts} || {} };
  93
  94 map({ handle_file($_, $bindir); } @progfiles);
  95 map({ handle_file($_, $dbupdir); } @dbplfiles);
  96 map({ handle_file($_, $dbupdir2); } @dbplfiles2);
  97
  98 # generate all
  99 generate_file(
 100   file      => "$locales_dir/all",
 101   header    => $ALL_HEADER,
 102   data_name => '$self->{texts}',
 103   data_sub  => sub { _print_line($_, $self->{texts}{$_}, @_) for sort keys %alllocales },
 104 );
 105
 106 # calc and generate missing
 107 push @missing, grep { !$self->{texts}{$_} } sort keys %alllocales;
 108
 109 if (@missing) {
 110   generate_file(
 111     file      => "$locales_dir/missing",
 112     header    => $MISSING_HEADER,
 113     data_name => '$missing',
 114     data_sub  => sub { _print_line($_, '', @_) for @missing },
 115   );
 116 }
 117
 118 # calc and generate lost
 119 while (my ($text, $translation) = each %old_texts) {
 120   next if ($alllocales{$text});
 121   push @lost, { 'text' => $text, 'translation' => $translation };
 122 }
 123
 124 if (scalar @lost) {
 125   splice @lost, 0, (scalar @lost - 50) if (scalar @lost > 50);
 126   generate_file(
 127     file      => "$locales_dir/lost",
 128     header    => $LOST_HEADER,
 129     delim     => '()',
 130     data_name => '@lost',
 131     data_sub  => sub {
 132       _print_line($_->{text}, $_->{translation}, @_, template => "  { 'text' => %s, 'translation' => %s },\n") for @lost;
 133     },
 134   );
 135 }
 136
 137 my $trlanguage = slurp("$locales_dir/LANGUAGE");
 138 chomp $trlanguage;
 139
 140 search_unused_htmlfiles() if $opt_c;
 141
 142 my $count  = scalar keys %alllocales;
 143 my $notext = scalar @missing;
 144 my $per    = sprintf("%.1f", ($count - $notext) / $count * 100);
 145 print "\n$trlanguage - ${per}%";
 146 print " - $notext/$count missing" if $notext;
 147 print "\n";
 148
 149 exit;
 150
 151 # eom
 152
 153 sub init {
 154   $ALL_HEADER = <<EOL;
 155 # These are all the texts to build the translations files.
 156 # The file has the form of 'english text'  => 'foreign text',
 157 # you can add the translation in this file or in the 'missing' file
 158 # run locales.pl from this directory to rebuild the translation files
 159 EOL
 160   $MISSING_HEADER = <<EOL;
 161 # add the missing texts and run locales.pl to rebuild
 162 EOL
 163   $LOST_HEADER  = <<EOL;
 164 # The last 50 text strings, that have been removed.
 165 # This file has been auto-generated by locales.pl. Please don't edit!
 166 EOL
 167 }
 168
 169 sub parse_args {
 170   my ($help, $man);
 171
 172   GetOptions(
 173     'no-custom-files' => \$opt_n,
 174     'check-files'     => \$opt_c,
 175     'verbose'         => \$opt_v,
 176     'help'            => \$help,
 177     'man'             => \$man,
 178     'debug'           => \$debug,
 179   );
 180
 181   if ($help) {
 182     pod2usage(1);
 183     exit 0;
 184   }
 185
 186   if ($man) {
 187     pod2usage(-exitstatus => 0, -verbose => 2);
 188     exit 0;
 189   }
 190
 191   if (@ARGV) {
 192     my $arg = shift @ARGV;
 193     my $ok  = 0;
 194     foreach my $dir ("../locale/$arg", "locale/$arg", "../$arg", $arg) {
 195       next unless -d $dir && -f "$dir/all" && -f "$dir/LANGUAGE";
 196       $ok = chdir $dir;
 197       last;
 198     }
 199
 200     if (!$ok) {
 201       print "The locale directory '$arg' could not be found.\n";
 202       exit 1;
 203     }
 204
 205   } elsif (!-f 'all' || !-f 'LANGUAGE') {
 206     print "locales.pl was not called from a locale/* subdirectory,\n"
 207       .   "and no locale directory name was given.\n";
 208     exit 1;
 209   }
 210 }
 211
 212 sub handle_file {
 213   my ($file, $dir) = @_;
 214   print "\n$file" if $opt_v;
 215   %locale = ();
 216   %submit = ();
 217
 218   &scanfile("$dir/$file");
 219
 220   # scan custom_{module}.pl or {login}_{module}.pl files
 221   foreach my $customfile (@customfiles) {
 222     if ($customfile =~ /_$file/) {
 223       if (-f "$dir/$customfile") {
 224         &scanfile("$dir/$customfile");
 225       }
 226     }
 227   }
 228
 229   # if this is the menu.pl file
 230   if ($file eq 'menu.pl') {
 231     foreach my $item (@menufiles) {
 232       &scanmenu("$basedir/$item");
 233     }
 234   }
 235
 236   if ($file eq 'menunew.pl') {
 237     foreach my $item (@menufiles) {
 238       &scanmenu("$basedir/$item");
 239       print "." if $opt_v;
 240     }
 241   }
 242
 243   $file =~ s/\.pl//;
 244
 245   foreach my $text (keys %$missing) {
 246     if ($locale{$text} || $htmllocale{$text}) {
 247       unless ($self->{texts}{$text}) {
 248         $self->{texts}{$text} = $missing->{$text};
 249       }
 250     }
 251   }
 252 }
 253
 254 sub extract_text_between_parenthesis {
 255   my ($fh, $line) = @_;
 256   my ($inside_string, $pos, $text, $quote_next) = (undef, 0, "", 0);
 257
 258   while (1) {
 259     if (length($line) <= $pos) {
 260       $line = <$fh>;
 261       return ($text, "") unless ($line);
 262       $pos = 0;
 263     }
 264
 265     my $cur_char = substr($line, $pos, 1);
 266
 267     if (!$inside_string) {
 268       if ((length($line) >= ($pos + 3)) && (substr($line, $pos, 2)) eq "qq") {
 269         $inside_string = substr($line, $pos + 2, 1);
 270         $pos += 2;
 271
 272       } elsif ((length($line) >= ($pos + 2)) &&
 273                (substr($line, $pos, 1) eq "q")) {
 274         $inside_string = substr($line, $pos + 1, 1);
 275         $pos++;
 276
 277       } elsif (($cur_char eq '"') || ($cur_char eq '\'')) {
 278         $inside_string = $cur_char;
 279
 280       } elsif (($cur_char eq ")") || ($cur_char eq ',')) {
 281         return ($text, substr($line, $pos + 1));
 282       }
 283
 284     } else {
 285       if ($quote_next) {
 286         $text .= $cur_char;
 287         $quote_next = 0;
 288
 289       } elsif ($cur_char eq '\\') {
 290         $text .= $cur_char;
 291         $quote_next = 1;
 292
 293       } elsif ($cur_char eq $inside_string) {
 294         undef($inside_string);
 295
 296       } else {
 297         $text .= $cur_char;
 298
 299       }
 300     }
 301     $pos++;
 302   }
 303 }
 304
 305 sub scanfile {
 306   my $file = shift;
 307   my $dont_include_subs = shift;
 308   my $scanned_files = shift;
 309
 310   # sanitize file
 311   $file =~ s=/+=/=g;
 312
 313   $scanned_files = {} unless ($scanned_files);
 314   return if ($scanned_files->{$file});
 315   $scanned_files->{$file} = 1;
 316
 317   if (!defined $cached{$file}) {
 318
 319     return unless (-f "$file");
 320
 321     my $fh = new FileHandle;
 322     open $fh, "$file" or die "$! : $file";
 323
 324     my ($is_submit, $line_no, $sub_line_no) = (0, 0, 0);
 325
 326     while (<$fh>) {
 327       $line_no++;
 328
 329       # is this another file
 330       if (/require\s+\W.*\.pl/) {
 331         my $newfile = $&;
 332         $newfile =~ s/require\s+\W//;
 333         $newfile =~ s|bin/mozilla||;
 334          $cached{$file}{scan}{"$bindir/$newfile"} = 1;
 335       } elsif (/use\s+SL::([\w:]*)/) {
 336         my $module =  $1;
 337         $module    =~ s|::|/|g;
 338         $cached{$file}{scannosubs}{"../../SL/${module}.pm"} = 1;
 339       }
 340
 341       # is this a template call?
 342       if (/parse_html_template2?\s*\(\s*[\"\']([\w\/]+)\s*[\"\']/) {
 343         my $newfile = "$basedir/templates/webpages/$1.html";
 344         if (/parse_html_template2/) {
 345           print "E: " . strip_base($file) . " is still using 'parse_html_template2' for " . strip_base($newfile) . ".\n";
 346         }
 347         if (-f $newfile) {
 348            $cached{$file}{scanh}{$newfile} = 1;
 349           print "." if $opt_v;
 350         } elsif ($opt_c) {
 351           print "W: missing HTML template: " . strip_base($newfile) . " (referenced from " . strip_base($file) . ")\n";
 352         }
 353       }
 354
 355       my $rc = 1;
 356
 357       while ($rc) {
 358         if (/Locale/) {
 359           unless (/^use /) {
 360             my ($null, $country) = split /,/;
 361             $country =~ s/^ +[\"\']//;
 362             $country =~ s/[\"\'].*//;
 363           }
 364         }
 365
 366         my $postmatch = "";
 367
 368         # is it a submit button before $locale->
 369         if (/$submitsearch/) {
 370           $postmatch = "$'";
 371           if ($` !~ /locale->text/) {
 372             $is_submit   = 1;
 373             $sub_line_no = $line_no;
 374           }
 375         }
 376
 377         my ($found) = /locale->text.*?\(/;
 378         $postmatch = "$'";
 379
 380         if ($found) {
 381           my $string;
 382           ($string, $_) = extract_text_between_parenthesis($fh, $postmatch);
 383           $postmatch = $_;
 384
 385           # if there is no $ in the string record it
 386           unless (($string =~ /\$\D.*/) || ("" eq $string)) {
 387
 388             # this guarantees one instance of string
 389             $cached{$file}{locale}{$string} = 1;
 390
 391             # this one is for all the locales
 392             $cached{$file}{all}{$string} = 1;
 393
 394             # is it a submit button before $locale->
 395             if ($is_submit) {
 396               $cached{$file}{submit}{$string} = 1;
 397             }
 398           }
 399         } elsif ($postmatch =~ />/) {
 400           $is_submit = 0;
 401         }
 402
 403         # exit loop if there are no more locales on this line
 404         ($rc) = ($postmatch =~ /locale->text/);
 405
 406         if (   ($postmatch =~ />/)
 407             || (!$found && ($sub_line_no != $line_no) && />/)) {
 408           $is_submit = 0;
 409         }
 410       }
 411     }
 412
 413     close($fh);
 414
 415   }
 416
 417   map { $alllocales{$_} = 1 }   keys %{$cached{$file}{all}};
 418   map { $locale{$_} = 1 }       keys %{$cached{$file}{locale}};
 419   map { $submit{$_} = 1 }       keys %{$cached{$file}{submit}};
 420   map { &scanfile($_, 0, $scanned_files) } keys %{$cached{$file}{scan}};
 421   map { &scanfile($_, 1, $scanned_files) } keys %{$cached{$file}{scannosubs}};
 422   map { &scanhtmlfile($_)  }    keys %{$cached{$file}{scanh}};
 423
 424   @referenced_html_files{keys %{$cached{$file}{scanh}}} = (1) x scalar keys %{$cached{$file}{scanh}};
 425 }
 426
 427 sub scanmenu {
 428   my $file = shift;
 429
 430   my $fh = new FileHandle;
 431   open $fh, "$file" or die "$! : $file";
 432
 433   my @a = grep m/^\[/, <$fh>;
 434   close($fh);
 435
 436   # strip []
 437   grep { s/(\[|\])//g } @a;
 438
 439   foreach my $item (@a) {
 440     my @b = split /--/, $item;
 441     foreach my $string (@b) {
 442       chomp $string;
 443       $locale{$string}     = 1;
 444       $alllocales{$string} = 1;
 445     }
 446   }
 447
 448 }
 449
 450 sub unescape_template_string {
 451   my $in =  "$_[0]";
 452   $in    =~ s/\\(.)/$1/g;
 453   return $in;
 454 }
 455
 456 sub scanhtmlfile {
 457   local *IN;
 458
 459   my $file = shift;
 460
 461   if (!defined $cached{$file}) {
 462     my %plugins = ( 'loaded' => { }, 'needed' => { } );
 463
 464     open(IN, $file) || die $file;
 465
 466     my $copying  = 0;
 467     my $issubmit = 0;
 468     my $text     = "";
 469     while (my $line = <IN>) {
 470       chomp($line);
 471
 472       while ($line =~ m/\[\%[^\w]*use[^\w]+(\w+)[^\w]*?\%\]/gi) {
 473         $plugins{loaded}->{$1} = 1;
 474       }
 475
 476       while ($line =~ m/\[\%[^\w]*(\w+)\.\w+\(/g) {
 477         my $plugin = $1;
 478         $plugins{needed}->{$plugin} = 1 if (first { $_ eq $plugin } qw(HTML LxERP JavaScript MultiColumnIterator L));
 479       }
 480
 481       while ($line =~ m/(?:             # Start von Variante 1: LxERP.t8('...'); ohne darumliegende [% ... %]-Tags
 482                           (LxERP\.t8)\( #   LxERP.t8(                             ::Parameter $1::
 483                           ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $2::
 484                           (.*?)         #   Der zu übersetzende String            ::Parameter $3::
 485                           (?<!\\)\2     #   Ende des zu übersetzenden Strings
 486                         |               # Start von Variante 2: [% '...' | $T8 %]
 487                           \[\%          #   Template-Start-Tag
 488                           [\-~#]?       #   Whitespace-Unterdrückung
 489                           \s*           #   Optional beliebig viele Whitespace
 490                           ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $4::
 491                           (.*?)         #   Der zu übersetzende String            ::Parameter $5::
 492                           (?<!\\)\4     #   Ende des zu übersetzenden Strings
 493                           \s*\|\s*      #   Pipe-Zeichen mit optionalen Whitespace davor und danach
 494                           (\$T8)        #   Filteraufruf                          ::Parameter $6::
 495                           .*?           #   Optionale Argumente für den Filter
 496                           \s*           #   Whitespaces
 497                           [\-~#]?       #   Whitespace-Unterdrückung
 498                           \%\]          #   Template-Ende-Tag
 499                         )
 500                        /ix) {
 501         my $module = $1 || $6;
 502         my $string = $3 || $5;
 503         print "Found filter >>>$string<<<\n" if $debug;
 504         substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
 505
 506         $string                         = unescape_template_string($string);
 507         $cached{$file}{all}{$string}    = 1;
 508         $cached{$file}{html}{$string}   = 1;
 509         $cached{$file}{submit}{$string} = 1 if $PREMATCH =~ /$submitsearch/;
 510         $plugins{needed}->{T8}          = 1 if $module eq '$T8';
 511         $plugins{needed}->{LxERP}       = 1 if $module eq 'LxERP.t8';
 512       }
 513
 514       while ($line =~ m/\[\%          # Template-Start-Tag
 515                         [\-~#]?       # Whitespace-Unterdrückung
 516                         \s*           # Optional beliebig viele Whitespace
 517                         (?:           # Die erkannten Template-Direktiven
 518                           PROCESS
 519                         |
 520                           INCLUDE
 521                         )
 522                         \s+           # Mindestens ein Whitespace
 523                         [\'\"]?       # Anfang des Dateinamens
 524                         ([^\s]+)      # Beliebig viele Nicht-Whitespaces -- Dateiname
 525                         \.html        # Endung ".html", ansonsten kann es der Name eines Blocks sein
 526                        /ix) {
 527         my $new_file_name = "$basedir/templates/webpages/$1.html";
 528         $cached{$file}{scanh}{$new_file_name} = 1;
 529         substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
 530       }
 531     }
 532
 533     close(IN);
 534
 535     foreach my $plugin (keys %{ $plugins{needed} }) {
 536       next if ($plugins{loaded}->{$plugin});
 537       print "E: " . strip_base($file) . " requires the Template plugin '$plugin', but is not loaded with '[\% USE $plugin \%]'.\n";
 538     }
 539   }
 540
 541   # copy back into global arrays
 542   map { $alllocales{$_} = 1 } keys %{$cached{$file}{all}};
 543   map { $locale{$_} = 1 }     keys %{$cached{$file}{html}};
 544   map { $submit{$_} = 1 }     keys %{$cached{$file}{submit}};
 545
 546   map { scanhtmlfile($_)  }   keys %{$cached{$file}{scanh}};
 547
 548   @referenced_html_files{keys %{$cached{$file}{scanh}}} = (1) x scalar keys %{$cached{$file}{scanh}};
 549 }
 550
 551 sub search_unused_htmlfiles {
 552   my @unscanned_dirs = ('../../templates/webpages');
 553
 554   while (scalar @unscanned_dirs) {
 555     my $dir = shift @unscanned_dirs;
 556
 557     foreach my $entry (<$dir/*>) {
 558       if (-d $entry) {
 559         push @unscanned_dirs, $entry;
 560
 561       } elsif (($entry =~ /_master.html$/) && -f $entry && !$referenced_html_files{$entry}) {
 562         print "W: unused HTML template: " . strip_base($entry) . "\n";
 563
 564       }
 565     }
 566   }
 567 }
 568
 569 sub strip_base {
 570   my $s =  "$_[0]";             # Create a copy of the string.
 571
 572   $s    =~ s|^../../||;
 573   $s    =~ s|templates/webpages/||;
 574
 575   return $s;
 576 }
 577
 578 sub _single_quote {
 579   my $val = shift;
 580   $val =~ s/(\'|\\$)/\\$1/g;
 581   return  "'" . $val .  "'";
 582 }
 583
 584 sub _print_line {
 585   my $key      = _single_quote(shift);
 586   my $text     = _single_quote(shift);
 587   my %params   = @_;
 588   my $template = $params{template} || qq|  %-29s => %s,\n|;
 589   my $fh       = $params{fh}       || croak 'need filehandle in _print_line';
 590
 591   print $fh sprintf $template, $key, $text;
 592 }
 593
 594 sub generate_file {
 595   my %params = @_;
 596
 597   my $file      = $params{file}   || croak 'need filename in generate_file';
 598   my $header    = $params{header};
 599   my $lines     = $params{data_sub};
 600   my $data_name = $params{data_name};
 601   my @delim     = split //, ($params{delim} || '{}');
 602
 603   open my $fh, '>:encoding(utf8)', $file or die "$! : $file";
 604
 605   $charset =~ s/\r?\n//g;
 606   my $emacs_charset = lc $charset;
 607
 608   print $fh "#!/usr/bin/perl\n# -*- coding: $emacs_charset; -*-\n# vim: fenc=$charset\n\nuse utf8;\n\n";
 609   print $fh $header, "\n" if $header;
 610   print $fh "$data_name = $delim[0]\n" if $data_name;
 611
 612   $lines->(fh => $fh);
 613
 614   print $fh qq|$delim[1];\n\n1;\n|;
 615   close $fh;
 616 }
 617
 618 sub slurp {
 619   my $file = shift;
 620   do { local ( @ARGV, $/ ) = $file; <> }
 621 }
 622
 623 __END__
 624
 625 =head1 NAME
 626
 627 locales.pl - Collect strings for translation in Lx-Office
 628
 629 =head1 SYNOPSIS
 630
 631 locales.pl [options] lang_code
 632
 633  Options:
 634   -n, --no-custom-files  Do not process files whose name contains "_"
 635   -c, --check-files      Run extended checks on HTML files
 636   -v, --verbose          Be more verbose
 637   -h, --help             Show this help
 638
 639 =head1 OPTIONS
 640
 641 =over 8
 642
 643 =item B<-n>, B<--no-custom-files>
 644
 645 Do not process files whose name contains "_", e.g. "custom_io.pl".
 646
 647 =item B<-c>, B<--check-files>
 648
 649 Run extended checks on the usage of templates. This can be used to
 650 discover HTML templates that are never used as well as the usage of
 651 non-existing HTML templates.
 652
 653 =item B<-v>, B<--verbose>
 654
 655 Be more verbose.
 656
 657 =back
 658
 659 =head1 DESCRIPTION
 660
 661 This script collects strings from Perl files, the menu.ini file and
 662 HTML templates and puts them into the file "all" for translation.
 663
 664 =cut