locale/de/locales.pl

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