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