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