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