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