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