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