"Gewichtseinheit" entfernt.
[kivitendo-erp.git] / locale / de / locales.pl
1 #!/usr/bin/perl
2
3 # -n do not include custom_ scripts
4 # -v verbose mode, shows progress stuff
5
6 # this version of locles processes not only all required .pl files
7 # but also all parse_html_templated files.
8
9 use POSIX;
10 use FileHandle;
11 use Data::Dumper;
12
13 $| = 1;
14
15 $basedir  = "../..";
16 $bindir   = "$basedir/bin/mozilla";
17 $dbupdir  = "$basedir/sql/Pg-upgrade";
18 $dbupdir2 = "$basedir/sql/Pg-upgrade2";
19 $menufile = "menu.ini";
20 $submitsearch = qr/type\s*=\s*[\"\']?submit/i;
21
22 foreach $item (@ARGV) {
23   $item =~ s/-//g;
24   $arg{$item} = 1;
25 }
26
27 opendir DIR, "$bindir" or die "$!";
28 @progfiles = grep { /\.pl/; !/(_|^\.)/ } readdir DIR;
29 seekdir DIR, 0;
30 @customfiles = grep /_/, readdir DIR;
31 closedir DIR;
32
33 # put customized files into @customfiles
34 @customfiles = () if ($arg{n});
35
36 if ($arg{n}) {
37   @menufiles = ($menufile);
38 } else {
39   opendir DIR, "$basedir" or die "$!";
40   @menufiles = grep { /.*?_$menufile$/ } readdir DIR;
41   closedir DIR;
42   unshift @menufiles, $menufile;
43 }
44
45 opendir DIR, $dbupdir or die "$!";
46 @dbplfiles = grep { /\.pl$/ } readdir DIR;
47 closedir DIR;
48
49 opendir DIR, $dbupdir2 or die "$!";
50 @dbplfiles2 = grep { /\.pl$/ } readdir DIR;
51 closedir DIR;
52
53 # slurp the translations in
54 if (-f 'all') {
55   require "all";
56 }
57
58 # Read HTML templates.
59 #%htmllocale = ();
60 #@htmltemplates = <../../templates/webpages/*/*_master.html>;
61 #foreach $file (@htmltemplates) {
62 #  scanhtmlfile($file);
63 #}
64
65 map({ handle_file($_, $bindir); } @progfiles);
66 map({ handle_file($_, $dbupdir); } @dbplfiles);
67 map({ handle_file($_, $dbupdir2); } @dbplfiles2);
68
69 sub handle_file {
70   my ($file, $dir) = @_;
71   print "\n$file" if $arg{v};
72   %locale = ();
73   %submit = ();
74   %subrt  = ();
75
76   &scanfile("$dir/$file");
77
78   # scan custom_{module}.pl or {login}_{module}.pl files
79   foreach $customfile (@customfiles) {
80     if ($customfile =~ /_$file/) {
81       if (-f "$dir/$customfile") {
82         &scanfile("$dir/$customfile");
83       }
84     }
85   }
86
87   # if this is the menu.pl file
88   if ($file eq 'menu.pl') {
89     foreach $item (@menufiles) {
90       &scanmenu("$basedir/$item");
91     }
92   }
93
94   if ($file eq 'menunew.pl') {
95     foreach $item (@menufiles) {
96       &scanmenu("$basedir/$item");
97       print "." if $arg{v};
98     }
99   }
100
101   $file =~ s/\.pl//;
102
103   eval { require 'missing'; };
104   unlink 'missing';
105
106   foreach $text (keys %$missing) {
107     if ($locale{$text} || $htmllocale{$text}) {
108       unless ($self->{texts}{$text}) {
109         $self->{texts}{$text} = $missing->{$text};
110       }
111     }
112   }
113
114   open FH, ">$file" or die "$! : $file";
115
116   print FH q|$self->{texts} = {
117 |;
118
119   foreach $key (sort keys %locale) {
120     if ($self->{texts}{$key}) {
121       $text = $self->{texts}{$key};
122     } else {
123       $text = $key;
124     }
125     $text =~ s/'/\\'/g;
126     $text =~ s/\\$/\\\\/;
127
128     $keytext = $key;
129     $keytext =~ s/'/\\'/g;
130     $keytext =~ s/\\$/\\\\/;
131
132     print FH qq|  '$keytext'|
133       . (' ' x (27 - length($keytext)))
134       . qq| => '$text',\n|;
135   }
136
137   print FH q|};
138
139 $self->{subs} = {
140 |;
141
142   foreach $key (sort keys %subrt) {
143     $text = $key;
144     $text =~ s/'/\\'/g;
145     $text =~ s/\\$/\\\\/;
146     print FH qq|  '$text'| . (' ' x (27 - length($text))) . qq| => '$text',\n|;
147   }
148
149   foreach $key (sort keys %submit) {
150     $text = ($self->{texts}{$key}) ? $self->{texts}{$key} : $key;
151     $text =~ s/'/\\'/g;
152     $text =~ s/\\$/\\\\/;
153
154     $english_sub = $key;
155     $english_sub =~ s/'/\\'/g;
156     $english_sub =~ s/\\$/\\\\/;
157     $english_sub = lc $key;
158
159     $translated_sub = lc $text;
160     $english_sub    =~ s/( |-|,)/_/g;
161     $translated_sub =~ s/( |-|,)/_/g;
162     print FH qq|  '$translated_sub'|
163       . (' ' x (27 - length($translated_sub)))
164       . qq| => '$english_sub',\n|;
165   }
166
167   print FH q|};
168
169 1;
170 |;
171
172   close FH;
173
174 }
175
176 #foreach $file (@htmltemplates) {
177 #  converthtmlfile($file);
178 #}
179
180 # now print out all
181
182 open FH, ">all" or die "$! : all";
183
184 print FH q|# These are all the texts to build the translations files.
185 # The file has the form of 'english text'  => 'foreign text',
186 # you can add the translation in this file or in the 'missing' file
187 # run locales.pl from this directory to rebuild the translation files
188
189 $self->{texts} = {
190 |;
191
192 foreach $key (sort keys %alllocales) {
193   $text = $self->{texts}{$key};
194
195   $count++;
196
197   $text =~ s/'/\\'/g;
198   $text =~ s/\\$/\\\\/;
199   $key  =~ s/'/\\'/g;
200   $key  =~ s/\\$/\\\\/;
201
202   unless ($text) {
203     $notext++;
204     push @missing, $key;
205   }
206
207   print FH qq|  '$key'| . (' ' x (27 - length($key))) . qq| => '$text',\n|;
208
209 }
210
211 print FH q|};
212
213 1;
214 |;
215
216 close FH;
217
218 if (@missing) {
219   open FH, ">missing" or die "$! : missing";
220
221   print FH q|# add the missing texts and run locales.pl to rebuild
222
223 $missing = {
224 |;
225
226   foreach $text (@missing) {
227     print FH qq|  '$text'| . (' ' x (27 - length($text))) . qq| => '',\n|;
228   }
229
230   print FH q|};
231
232 1;
233 |;
234
235   close FH;
236
237 }
238
239 open(FH, "LANGUAGE");
240 @language = <FH>;
241 close(FH);
242 $trlanguage = $language[0];
243 chomp $trlanguage;
244
245 $per = sprintf("%.1f", ($count - $notext) / $count * 100);
246 print "\n$trlanguage - ${per}%";
247 print " - $notext missing" if $notext;
248 print "\n";
249
250 exit;
251
252 # eom
253
254 sub extract_text_between_parenthesis {
255   my ($fh, $line) = @_;
256   my ($inside_string, $pos, $text, $quote_next) = (undef, 0, "", 0);
257
258   while (1) {
259     if (length($line) <= $pos) {
260       $line = <$fh>;
261       return ($text, "") unless ($line);
262       $pos = 0;
263     }
264
265     my $cur_char = substr($line, $pos, 1);
266
267     if (!$inside_string) {
268       if ((length($line) >= ($pos + 3)) && (substr($line, $pos, 2)) eq "qq") {
269         $inside_string = substr($line, $pos + 2, 1);
270         $pos += 2;
271
272       } elsif ((length($line) >= ($pos + 2)) &&
273                (substr($line, $pos, 1) eq "q")) {
274         $inside_string = substr($line, $pos + 1, 1);
275         $pos++;
276
277       } elsif (($cur_char eq '"') || ($cur_char eq '\'')) {
278         $inside_string = $cur_char;
279
280       } elsif ($cur_char eq ")") {
281         return ($text, substr($line, $pos + 1));
282       }
283
284     } else {
285       if ($quote_next) {
286         $text .= $cur_char;
287         $quote_next = 0;
288
289       } elsif ($cur_char eq '\\') {
290         $text .= $cur_char;
291         $quote_next = 1;
292
293       } elsif ($cur_char eq $inside_string) {
294         undef($inside_string);
295
296       } else {
297         $text .= $cur_char;
298
299       }
300     }
301     $pos++;
302   }
303 }
304
305 sub scanfile {
306   my $file = shift;
307   my $dont_include_subs = shift;
308   my $scanned_files = shift;
309
310   $scanned_files = {} unless ($scanned_files);
311   return if ($scanned_files->{$file});
312   $scanned_files->{$file} = 1;
313
314   if (!defined $cached{$file}) {
315
316     return unless (-f "$file");
317
318     my $fh = new FileHandle;
319     open $fh, "$file" or die "$! : $file";
320
321     my ($is_submit, $line_no, $sub_line_no) = (0, 0, 0);
322
323     while (<$fh>) {
324       $line_no++;
325
326       # is this another file
327       if (/require\s+\W.*\.pl/) {
328         my $newfile = $&;
329         $newfile =~ s/require\s+\W//;
330         $newfile =~ s/\$form->{path}\///;
331 #         &scanfile("$bindir/$newfile", 0, $scanned_files);
332          $cached{$file}{scan}{"$bindir/$newfile"} = 1;
333       } elsif (/use\s+SL::(.*?);/) {
334 #         &scanfile("../../SL/${1}.pm", 1, $scanned_files);
335          $cached{$file}{scannosubs}{"../../SL/${1}.pm"} = 1;
336       }
337
338       # is this a template call?
339       if (/parse_html_template\s*\(\s*[\"\']([\w\/]+)/) {
340         my $newfile = "$basedir/templates/webpages/$1_master.html";
341         if (-f $newfile) {
342 #           &scanhtmlfile($newfile);
343 #           &converthtmlfile($newfile);
344            $cached{$file}{scanh}{$newfile} = 1;
345           print "." if $arg{v};
346         }
347       }
348
349       # is this a sub ?
350       if (/^sub /) {
351         next if ($dont_include_subs);
352         ($null, $subrt) = split / +/;
353 #        $subrt{$subrt} = 1;
354         $cached{$file}{subr}{$subrt} = 1;
355         next;
356       }
357
358       my $rc = 1;
359
360       while ($rc) {
361         if (/Locale/) {
362           unless (/^use /) {
363             my ($null, $country) = split /,/;
364             $country =~ s/^ +[\"\']//;
365             $country =~ s/[\"\'].*//;
366           }
367         }
368
369         my $postmatch = "";
370
371         # is it a submit button before $locale->
372         if (/$submitsearch/) {
373           $postmatch = "$'";
374           if ($` !~ /locale->text/) {
375             $is_submit   = 1;
376             $sub_line_no = $line_no;
377           }
378         }
379
380         my ($found) = /locale->text.*?\(/;
381         my $postmatch = "$'";
382
383         if ($found) {
384           my $string;
385           ($string, $_) = extract_text_between_parenthesis($fh, $postmatch);
386           $postmatch = $_;
387
388           # if there is no $ in the string record it
389           unless (($string =~ /\$\D.*/) || ("" eq $string)) {
390
391             # this guarantees one instance of string
392 #            $locale{$string} = 1;
393             $cached{$file}{locale}{$string} = 1;
394
395             # this one is for all the locales
396 #            $alllocales{$string} = 1;
397             $cached{$file}{all}{$string} = 1;
398
399             # is it a submit button before $locale->
400             if ($is_submit) {
401 #              $submit{$string} = 1;
402               $cached{$file}{submit}{$string} = 1;
403             }
404           }
405         } elsif ($postmatch =~ />/) {
406           $is_submit = 0;
407         }
408
409         # exit loop if there are no more locales on this line
410         ($rc) = ($postmatch =~ /locale->text/);
411
412         if (   ($postmatch =~ />/)
413             || (!$found && ($sub_line_no != $line_no) && />/)) {
414           $is_submit = 0;
415         }
416       }
417     }
418
419     close($fh);
420
421   }
422
423   map { $alllocales{$_} = 1 }   keys %{$cached{$file}{all}};
424   map { $locale{$_} = 1 }       keys %{$cached{$file}{locale}};
425   map { $submit{$_} = 1 }       keys %{$cached{$file}{submit}};
426   map { $subrt{$_} = 1 }        keys %{$cached{$file}{subr}};
427   map { &scanfile($_, 0, $scanned_files) } keys %{$cached{$file}{scan}};
428   map { &scanfile($_, 1, $scanned_files) } keys %{$cached{$file}{scannosubs}};
429   map { &scanhtmlfile($_)  }    keys %{$cached{$file}{scanh}};
430 }
431
432 sub scanmenu {
433   my $file = shift;
434
435   my $fh = new FileHandle;
436   open $fh, "$file" or die "$! : $file";
437
438   my @a = grep /^\[/, <$fh>;
439   close($fh);
440
441   # strip []
442   grep { s/(\[|\])//g } @a;
443
444   foreach my $item (@a) {
445     @b = split /--/, $item;
446     foreach $string (@b) {
447       chomp $string;
448       $locale{$string}     = 1;
449       $alllocales{$string} = 1;
450     }
451   }
452
453 }
454
455 sub scanhtmlfile {
456   local *IN;
457  
458   if (!defined $cached{$_[0]}) {
459  
460     open(IN, $_[0]) || die $_[0];
461
462     my $copying = 0;
463     my $issubmit = 0;
464     my $text = "";
465     while (my $line = <IN>) {
466       chomp($line);
467
468       while ("" ne $line) {
469         if (!$copying) {
470           if ($line =~ m|<translate>|i) {
471             my $eom = $+[0];
472             if ($` =~ /$submitsearch/) {
473               $issubmit = 1
474             }
475             substr($line, 0, $eom) = "";
476             $copying = 1;
477           } else {
478             $line = "";
479           }
480
481         } else {
482           if ($line =~ m|</translate>|i) {
483             $text .= $`;
484             substr($line, 0, $+[0]) = "";
485             $text =~ s/\s+/ /g;
486
487             $copying = 0; 
488             if ($issubmit) {
489   #            $submit{$text} = 1;
490                $cached{$_[0]}{submit}{$text} = 1;
491               $issubmit = 0;
492             }
493   #          $alllocales{$text} = 1;
494              $cached{$_[0]}{all}{$text} = 1;
495   #          $htmllocale{$text} = 1;
496              $cached{$_[0]}{html}{$text} = 1;
497             $text = "";
498
499           } else {
500             $text .= $line;
501             $line = "";
502           }
503         }
504       }
505     }
506
507     close(IN);
508     &converthtmlfile($_[0]);
509   }
510
511   # copy back into global arrays
512   map { $alllocales{$_} = 1 }  keys %{$cached{$_[0]}{all}};
513   map { $htmllocales{$_} = 1 } keys %{$cached{$_[0]}{html}};
514   map { $submit{$_} = 1 }      keys %{$cached{$_[0]}{submit}};
515 }
516
517 sub converthtmlfile {
518   local *IN;
519   local *OUT;
520
521   my $file = shift;
522
523   open(IN, $file) || die;
524
525   my $langcode = (split("/", getcwd()))[-1];
526   $file =~ s/_master.html$/_${langcode}.html/;
527
528   open(OUT, ">$file") || die;
529
530   my $copying = 0;
531   my $text = "";
532   while (my $line = <IN>) {
533     chomp($line);
534     if ("" eq $line) {
535       print(OUT "\n");
536       next;
537     }
538
539     while ("" ne $line) {
540       if (!$copying) {
541         if ($line =~ m|<translate>|i) {
542           print(OUT $`);
543           substr($line, 0, $+[0]) = "";
544           $copying = 1;
545           print(OUT "\n") if ("" eq $line);
546
547         } else {
548           print(OUT "${line}\n");
549           $line = "";
550         }
551
552       } else {
553         if ($line =~ m|</translate>|i) {
554           $text .= $`;
555           substr($line, 0, $+[0]) = "";
556           $text =~ s/\s+/ /g;
557           $copying = 0;
558           $alllocales{$text} = 1;
559           $htmllocale{$text} = 1;
560           print(OUT $self->{"texts"}{$text} || $text);
561           print(OUT "\n") if ("" eq $line);
562           $text = "";
563
564         } else {
565           $text .= $line;
566           $line = "";
567         }
568       }
569     }
570   }
571
572   close(IN);
573   close(OUT);
574 }