locale/de/locales.pl

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