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