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