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