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