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