sql-ledger/sql-ledger/locale/de/locales.pl

   1 #!/usr/bin/perl
   2
   3 # -n do not include custom_ scripts
   4 # -a build all file
   5
   6 use FileHandle;
   7
   8
   9 $basedir = "../..";
  10 $bindir = "$basedir/bin/mozilla";
  11 $menufile = "menu.ini";
  12
  13 foreach $item (@ARGV) {
  14   $item =~ s/-//g;
  15   $arg{$item} = 1;
  16 }
  17
  18 opendir DIR, "$bindir" or die "$!";
  19 @progfiles = grep { /\.pl/; !/(_|^\.)/ } readdir DIR;
  20 seekdir DIR, 0;
  21 @customfiles = grep /_/, readdir DIR;
  22 closedir DIR;
  23
  24 # put customized files into @customfiles
  25 @customfiles = () if ($arg{n});
  26
  27 if ($arg{n}) {
  28   @menufiles = ($menufile);
  29 } else {
  30   opendir DIR, "$basedir" or die "$!";
  31   @menufiles = grep { /.*?_$menufile$/ } readdir DIR;
  32   closedir DIR;
  33   unshift @menufiles, $menufile;
  34 }
  35
  36
  37 if (-f 'all') {    # use the old all file
  38   require "all";
  39   %oldall = %{ $self{texts} };
  40 }
  41
  42 # remove the old missing file
  43 if (-f 'missing') {
  44   unlink "missing";
  45 }
  46
  47 foreach $file (@progfiles) {
  48
  49   %locale = ();
  50   %submit = ();
  51   %subrt = ();
  52   @missing = ();
  53   %missing = ();
  54
  55   $file =~ s/\.pl//;
  56
  57   # read $file if it exists
  58   eval { require "$file"; };
  59
  60   &scanfile("$bindir/${file}.pl");
  61
  62   # scan custom_{module}.pl or {login}_{module}.pl files
  63   foreach $customfile (@customfiles) {
  64     if ($customfile =~ /_${file}\.pl/) {
  65       if (-f "$bindir/$customfile") {
  66         &scanfile("$bindir/$customfile");
  67       }
  68     }
  69   }
  70
  71   # if this is the menu.pl file
  72   if ($file eq 'menu') {
  73     foreach $item (@menufiles) {
  74       &scanmenu("$basedir/$item");
  75     }
  76   }
  77
  78   eval { require "$file.missing"; };
  79   unlink "$file.missing";
  80
  81   if (%oldall) {    # use the old all file
  82     %{ $self{texts} } = %oldall;
  83   }
  84
  85   map { $self{texts}{$_} = $missing->{$_} if $missing->{$_} } keys %$missing;
  86
  87   open FH, ">$file" or die "$! : $file";
  88
  89   print FH q|$self{texts} = {
  90 |;
  91
  92   foreach $key (sort keys %locale) {
  93     $text = $self{texts}{$key};
  94     $count++;
  95
  96     $text =~ s/'/\\'/g;
  97     $text =~ s/\\$/\\\\/;
  98
  99     $keytext = $key;
 100     $keytext =~ s/'/\\'/g;
 101     $keytext =~ s/\\$/\\\\/;
 102
 103     $all{$keytext} = $text;
 104
 105     if (!$text) {
 106       $notext++;
 107       push @missing, $keytext;
 108       next;
 109     }
 110
 111     print FH qq|  '$keytext'|.(' ' x (27-length($keytext))).qq| => '$text',\n|;
 112   }
 113
 114   print FH q|};
 115
 116 $self{subs} = {
 117 |;
 118
 119   foreach $key (sort keys %subrt) {
 120     $text = $key;
 121     $text =~ s/'/\\'/g;
 122     $text =~ s/\\$/\\\\/;
 123     print FH qq|  '$text'|.(' ' x (27-length($text))).qq| => '$text',\n|;
 124   }
 125
 126   foreach $key (sort keys %submit) {
 127     $text = ($self{texts}{$key}) ? $self{texts}{$key} : $key;
 128     $text =~ s/'/\\'/g;
 129     $text =~ s/\\$/\\\\/;
 130
 131     $english_sub = $key;
 132     $english_sub =~ s/'/\\'/g;
 133     $english_sub =~ s/\\$/\\\\/;
 134     $english_sub = lc $key;
 135
 136     $translated_sub = lc $text;
 137     $english_sub =~ s/( |-|,)/_/g;
 138     $translated_sub =~ s/( |-|,)/_/g;
 139     print FH qq|  '$translated_sub'|.(' ' x (27-length($translated_sub))).qq| => '$english_sub',\n|;
 140   }
 141
 142   print FH q|};
 143
 144 1;
 145 |;
 146
 147   close FH;
 148
 149
 150   if (@missing) {
 151     open FH, ">$file.missing" or die "$! : missing";
 152
 153     print FH qq|# module $file
 154 # add the missing texts and run locales.pl to rebuild
 155
 156 \$missing = {
 157 |;
 158
 159     foreach $text (@missing) {
 160       print FH qq|  '$text'|.(' ' x (27-length($text))).qq| => '',\n|;
 161     }
 162
 163     print FH q|};
 164
 165 1;
 166 |;
 167
 168     close FH;
 169
 170   }
 171
 172
 173   # redo the old all file
 174   if ($arg{a}) {
 175     open FH, ">all" or die "$! : all";
 176
 177     print FH qq|# These are all the texts to build the translations files.
 178 # to build unique strings edit the module files instead
 179 # this file is just a shortcut to build strings which are the same
 180
 181 \$self{texts} = {
 182 |;
 183
 184     foreach $text (sort keys %all) {
 185       print FH qq|  '$text'|.(' ' x (27-length($text))).qq| => '$all{$text}',\n|;
 186     }
 187
 188     print FH q|};
 189
 190 1;
 191 |;
 192
 193     close FH;
 194
 195   }
 196
 197 }
 198
 199 open(FH, "LANGUAGE");
 200 @language = <FH>;
 201 close(FH);
 202 $trlanguage = $language[0];
 203 chomp $trlanguage;
 204
 205 $per = sprintf("%.1f", ($count - $notext) / $count * 100);
 206 print "\n$trlanguage - ${per}%\n";
 207
 208 exit;
 209 # eom
 210
 211
 212 sub scanfile {
 213   my $file = shift;
 214
 215   return unless (-f "$file");
 216
 217   my $fh = new FileHandle;
 218   open $fh, "$file" or die "$! : $file";
 219
 220   while (<$fh>) {
 221     # is this another file
 222     if (/require\s+\W.*\.pl/) {
 223       my $newfile = $&;
 224       $newfile =~ s/require\s+\W//;
 225       $newfile =~ s/\$form->{path}\///;
 226       &scanfile("$bindir/$newfile");
 227     }
 228
 229     # is this a sub ?
 230     if (/^sub /) {
 231       ($null, $subrt) = split / +/;
 232       $subrt{$subrt} = 1;
 233       next;
 234     }
 235
 236     my $rc = 1;
 237
 238     while ($rc) {
 239       if (/Locale/) {
 240         if (!/^use /) {
 241           my ($null, $country) = split /,/;
 242           $country =~ s/^ +["']//;
 243           $country =~ s/["'].*//;
 244         }
 245       }
 246
 247       if (/\$locale->text.*?\W\)/) {
 248         my $string = $&;
 249         $string =~ s/\$locale->text\(\s*['"(q|qq)]['\/\\\|~]*//;
 250         $string =~ s/\W\)+.*$//;
 251
 252         # if there is no $ in the string record it
 253         unless ($string =~ /\$\D.*/) {
 254           # this guarantees one instance of string
 255           $locale{$string} = 1;
 256
 257           # is it a submit button before $locale->
 258           if (/type=submit/i) {
 259             $submit{$string} = 1;
 260           }
 261         }
 262       }
 263
 264       # exit loop if there are no more locales on this line
 265       ($rc) = ($' =~ /\$locale->text/);
 266       # strip text
 267       s/^.*?\$locale->text.*?\)//;
 268     }
 269   }
 270
 271   close($fh);
 272
 273 }
 274
 275
 276 sub scanmenu {
 277   my $file = shift;
 278
 279   my $fh = new FileHandle;
 280   open $fh, "$file" or die "$! : $file";
 281
 282   my @a = grep /^\[/, <$fh>;
 283   close($fh);
 284
 285   # strip []
 286   grep { s/(\[|\])//g } @a;
 287
 288   foreach my $item (@a) {
 289     $item =~ s/ *$//;
 290     @b = split /--/, $item;
 291     foreach $string (@b) {
 292       chomp $string;
 293       $locale{$string} = 1 if $string !~ /^\s*$/;
 294     }
 295   }
 296
 297 }
 298
 299