locale/de/locales.pl

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