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