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