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