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