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