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