locale/de/locales.pl

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