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