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         my $module =  $1;
 347         $module    =~ s|::|/|g;
 348 #         &scanfile("../../SL/${1}.pm", 1, $scanned_files);
 349         $cached{$file}{scannosubs}{"../../SL/${module}.pm"} = 1;
 350       }
 351
 352       # is this a template call?
 353       if (/parse_html_template2?\s*\(\s*[\"\']([\w\/]+)\s*[\"\']/) {
 354         my $newfile = "$basedir/templates/webpages/$1_master.html";
 355         if (/parse_html_template2/) {
 356           print "E: " . strip_base($file) . " is still using 'parse_html_template2' for " . strip_base($newfile) . ".\n";
 357         }
 358         if (-f $newfile) {
 359 #           &scanhtmlfile($newfile);
 360 #           &converthtmlfile($newfile);
 361            $cached{$file}{scanh}{$newfile} = 1;
 362           print "." if $arg{v};
 363         } elsif ($arg{h}) {
 364           print "W: missing HTML template: " . strip_base($newfile) . " (referenced from " . strip_base($file) . ")\n";
 365         }
 366       }
 367
 368       # is this a sub ?
 369       if (/^sub /) {
 370         next if ($dont_include_subs);
 371         ($null, $subrt) = split / +/;
 372 #        $subrt{$subrt} = 1;
 373         $cached{$file}{subr}{$subrt} = 1;
 374         next;
 375       }
 376
 377       my $rc = 1;
 378
 379       while ($rc) {
 380         if (/Locale/) {
 381           unless (/^use /) {
 382             my ($null, $country) = split /,/;
 383             $country =~ s/^ +[\"\']//;
 384             $country =~ s/[\"\'].*//;
 385           }
 386         }
 387
 388         my $postmatch = "";
 389
 390         # is it a submit button before $locale->
 391         if (/$submitsearch/) {
 392           $postmatch = "$'";
 393           if ($` !~ /locale->text/) {
 394             $is_submit   = 1;
 395             $sub_line_no = $line_no;
 396           }
 397         }
 398
 399         my ($found) = /locale->text.*?\(/;
 400         my $postmatch = "$'";
 401
 402         if ($found) {
 403           my $string;
 404           ($string, $_) = extract_text_between_parenthesis($fh, $postmatch);
 405           $postmatch = $_;
 406
 407           # if there is no $ in the string record it
 408           unless (($string =~ /\$\D.*/) || ("" eq $string)) {
 409
 410             # this guarantees one instance of string
 411 #            $locale{$string} = 1;
 412             $cached{$file}{locale}{$string} = 1;
 413
 414             # this one is for all the locales
 415 #            $alllocales{$string} = 1;
 416             $cached{$file}{all}{$string} = 1;
 417
 418             # is it a submit button before $locale->
 419             if ($is_submit) {
 420 #              $submit{$string} = 1;
 421               $cached{$file}{submit}{$string} = 1;
 422             }
 423           }
 424         } elsif ($postmatch =~ />/) {
 425           $is_submit = 0;
 426         }
 427
 428         # exit loop if there are no more locales on this line
 429         ($rc) = ($postmatch =~ /locale->text/);
 430
 431         if (   ($postmatch =~ />/)
 432             || (!$found && ($sub_line_no != $line_no) && />/)) {
 433           $is_submit = 0;
 434         }
 435       }
 436     }
 437
 438     close($fh);
 439
 440   }
 441
 442   map { $alllocales{$_} = 1 }   keys %{$cached{$file}{all}};
 443   map { $locale{$_} = 1 }       keys %{$cached{$file}{locale}};
 444   map { $submit{$_} = 1 }       keys %{$cached{$file}{submit}};
 445   map { $subrt{$_} = 1 }        keys %{$cached{$file}{subr}};
 446   map { &scanfile($_, 0, $scanned_files) } keys %{$cached{$file}{scan}};
 447   map { &scanfile($_, 1, $scanned_files) } keys %{$cached{$file}{scannosubs}};
 448   map { &scanhtmlfile($_)  }    keys %{$cached{$file}{scanh}};
 449
 450   @referenced_html_files{keys %{$cached{$file}{scanh}}} = (1) x scalar keys %{$cached{$file}{scanh}};
 451 }
 452
 453 sub scanmenu {
 454   my $file = shift;
 455
 456   my $fh = new FileHandle;
 457   open $fh, "$file" or die "$! : $file";
 458
 459   my @a = grep m/^\[/, <$fh>;
 460   close($fh);
 461
 462   # strip []
 463   grep { s/(\[|\])//g } @a;
 464
 465   foreach my $item (@a) {
 466     @b = split /--/, $item;
 467     foreach $string (@b) {
 468       chomp $string;
 469       $locale{$string}     = 1;
 470       $alllocales{$string} = 1;
 471     }
 472   }
 473
 474 }
 475
 476 sub scanhtmlfile {
 477   local *IN;
 478
 479   if (!defined $cached{$_[0]}) {
 480
 481     open(IN, $_[0]) || die $_[0];
 482
 483     my $copying = 0;
 484     my $issubmit = 0;
 485     my $text = "";
 486     while (my $line = <IN>) {
 487       chomp($line);
 488
 489       while ("" ne $line) {
 490         if (!$copying) {
 491           if ($line =~ m|<translate>|i) {
 492             my $eom = $+[0];
 493             if ($` =~ /$submitsearch/) {
 494               $issubmit = 1
 495             }
 496             substr($line, 0, $eom) = "";
 497             $copying = 1;
 498           } else {
 499             $line = "";
 500           }
 501
 502         } else {
 503           if ($line =~ m|</translate>|i) {
 504             $text .= $`;
 505             substr($line, 0, $+[0]) = "";
 506             $text =~ s/\s+/ /g;
 507
 508             $copying = 0;
 509             if ($issubmit) {
 510   #            $submit{$text} = 1;
 511                $cached{$_[0]}{submit}{$text} = 1;
 512               $issubmit = 0;
 513             }
 514   #          $alllocales{$text} = 1;
 515              $cached{$_[0]}{all}{$text} = 1;
 516   #          $htmllocale{$text} = 1;
 517              $cached{$_[0]}{html}{$text} = 1;
 518             $text = "";
 519
 520           } else {
 521             $text .= $line;
 522             $line = "";
 523           }
 524         }
 525       }
 526     }
 527
 528     close(IN);
 529     &converthtmlfile($_[0]);
 530   }
 531
 532   # copy back into global arrays
 533   map { $alllocales{$_} = 1 }  keys %{$cached{$_[0]}{all}};
 534   map { $htmllocales{$_} = 1 } keys %{$cached{$_[0]}{html}};
 535   map { $submit{$_} = 1 }      keys %{$cached{$_[0]}{submit}};
 536 }
 537
 538 sub converthtmlfile {
 539   local *IN;
 540   local *OUT;
 541
 542   my $file = shift;
 543
 544   open(IN, $file) || die;
 545
 546   my $langcode = (split("/", getcwd()))[-1];
 547   $file =~ s/_master.html$/_${langcode}.html/;
 548
 549   open(OUT, ">$file") || die;
 550
 551   my $copying = 0;
 552   my $text = "";
 553   while (my $line = <IN>) {
 554     chomp($line);
 555     if ("" eq $line) {
 556       print(OUT "\n");
 557       next;
 558     }
 559
 560     while ("" ne $line) {
 561       if (!$copying) {
 562         if ($line =~ m|<translate>|i) {
 563           print(OUT $`);
 564           substr($line, 0, $+[0]) = "";
 565           $copying = 1;
 566           print(OUT "\n") if ("" eq $line);
 567
 568         } else {
 569           print(OUT "${line}\n");
 570           $line = "";
 571         }
 572
 573       } else {
 574         if ($line =~ m|</translate>|i) {
 575           $text .= $`;
 576           substr($line, 0, $+[0]) = "";
 577           $text =~ s/\s+/ /g;
 578           $copying = 0;
 579           $alllocales{$text} = 1;
 580           $htmllocale{$text} = 1;
 581           print(OUT $self->{"texts"}{$text} || $text);
 582           print(OUT "\n") if ("" eq $line);
 583           $text = "";
 584
 585         } else {
 586           $text .= $line;
 587           $line = "";
 588         }
 589       }
 590     }
 591   }
 592
 593   close(IN);
 594   close(OUT);
 595 }
 596
 597 sub search_unused_htmlfiles {
 598   my @unscanned_dirs = ('../../templates/webpages');
 599
 600   while (scalar @unscanned_dirs) {
 601     my $dir = shift @unscanned_dirs;
 602
 603     foreach my $entry (<$dir/*>) {
 604       if (-d $entry) {
 605         push @unscanned_dirs, $entry;
 606
 607       } elsif (($entry =~ /_master.html$/) && -f $entry && !$referenced_html_files{$entry}) {
 608         print "W: unused HTML template: " . strip_base($entry) . "\n";
 609
 610       }
 611     }
 612   }
 613 }
 614
 615 sub search_translated_htmlfiles_wo_master {
 616   my @unscanned_dirs = ('../../templates/webpages');
 617
 618   while (scalar @unscanned_dirs) {
 619     my $dir = shift @unscanned_dirs;
 620
 621     foreach my $entry (<$dir/*>) {
 622       if (-d $entry) {
 623         push @unscanned_dirs, $entry;
 624
 625       } elsif (($entry =~ /_[a-z]+\.html$/) && ($entry !~ /_master.html$/) && -f $entry) {
 626         my $master =  $entry;
 627         $master    =~ s/[a-z]+\.html$/master.html/;
 628         if (! -f $master) {
 629           print "W: translated HTML template without master: " . strip_base($entry) . "\n";
 630         }
 631       }
 632     }
 633   }
 634 }
 635
 636 sub strip_base {
 637   $_[0] =~ s|^../../||;
 638   $_[0] =~ s|templates/webpages/||;
 639
 640   return $_[0];
 641 }