Lieferscheine auch im Webdav speichern.
[kivitendo-erp.git] / locale / en / 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 Data::Dumper;
10 use FileHandle;
11 use Getopt::Long;
12 use List::Util qw(first);
13 use POSIX;
14 use Pod::Usage;
15
16 $| = 1;
17
18 $basedir  = "../..";
19 $bindir   = "$basedir/bin/mozilla";
20 $dbupdir  = "$basedir/sql/Pg-upgrade";
21 $dbupdir2 = "$basedir/sql/Pg-upgrade2";
22 $menufile = "menu.ini";
23 $submitsearch = qr/type\s*=\s*[\"\']?submit/i;
24
25 %referenced_html_files = ();
26
27 my $opt_v = 0;
28 my $opt_n = 0;
29 my $opt_c = 0;
30
31 sub parse_args {
32   my ($help, $man);
33
34   GetOptions('no-custom-files' => \$opt_n,
35              'check-files'     => \$opt_c,
36              'verbose'         => \$opt_v,
37              'help'            => \$help,
38              'man'             => \$man,);
39
40   if ($help) {
41     pod2usage(1);
42     exit 0;
43   }
44
45   if ($man) {
46     pod2usage(-exitstatus => 0, -verbose => 2);
47     exit 0;
48   }
49 }
50
51 parse_args();
52
53 opendir DIR, "$bindir" or die "$!";
54 @progfiles = grep { /\.pl$/ && !/(_|^\.)/ } readdir DIR;
55 seekdir DIR, 0;
56 @customfiles = grep /_/, readdir DIR;
57 closedir DIR;
58
59 # put customized files into @customfiles
60
61 if ($opt_n) {
62   @customfiles = ();
63   @menufiles   = ($menufile);
64 } else {
65   opendir DIR, "$basedir" or die "$!";
66   @menufiles = grep { /.*?_$menufile$/ } readdir DIR;
67   closedir DIR;
68   unshift @menufiles, $menufile;
69 }
70
71 opendir DIR, $dbupdir or die "$!";
72 @dbplfiles = grep { /\.pl$/ } readdir DIR;
73 closedir DIR;
74
75 opendir DIR, $dbupdir2 or die "$!";
76 @dbplfiles2 = grep { /\.pl$/ } readdir DIR;
77 closedir DIR;
78
79 # slurp the translations in
80 if (-f 'all') {
81   require "all";
82 }
83
84 my %old_texts = %{ $self->{texts} };
85
86 # Read HTML templates.
87 #%htmllocale = ();
88 #@htmltemplates = <../../templates/webpages/*/*_master.html>;
89 #foreach $file (@htmltemplates) {
90 #  scanhtmlfile($file);
91 #}
92
93 map({ handle_file($_, $bindir); } @progfiles);
94 map({ handle_file($_, $dbupdir); } @dbplfiles);
95 map({ handle_file($_, $dbupdir2); } @dbplfiles2);
96
97 sub handle_file {
98   my ($file, $dir) = @_;
99   print "\n$file" if $opt_v;
100   %locale = ();
101   %submit = ();
102   %subrt  = ();
103
104   &scanfile("$dir/$file");
105
106   # scan custom_{module}.pl or {login}_{module}.pl files
107   foreach $customfile (@customfiles) {
108     if ($customfile =~ /_$file/) {
109       if (-f "$dir/$customfile") {
110         &scanfile("$dir/$customfile");
111       }
112     }
113   }
114
115   # if this is the menu.pl file
116   if ($file eq 'menu.pl') {
117     foreach $item (@menufiles) {
118       &scanmenu("$basedir/$item");
119     }
120   }
121
122   if ($file eq 'menunew.pl') {
123     foreach $item (@menufiles) {
124       &scanmenu("$basedir/$item");
125       print "." if $opt_v;
126     }
127   }
128
129   $file =~ s/\.pl//;
130
131   eval { require 'missing'; };
132   unlink 'missing';
133
134   foreach $text (keys %$missing) {
135     if ($locale{$text} || $htmllocale{$text}) {
136       unless ($self->{texts}{$text}) {
137         $self->{texts}{$text} = $missing->{$text};
138       }
139     }
140   }
141
142   open FH, ">$file" or die "$! : $file";
143
144   print FH q|#!/usr/bin/perl
145
146 $self->{texts} = {
147 |;
148
149   foreach $key (sort keys %locale) {
150     if ($self->{texts}{$key}) {
151       $text = $self->{texts}{$key};
152     } else {
153       $text = $key;
154     }
155     $text =~ s/'/\\'/g;
156     $text =~ s/\\$/\\\\/;
157
158     $keytext = $key;
159     $keytext =~ s/'/\\'/g;
160     $keytext =~ s/\\$/\\\\/;
161
162     print FH qq|  '$keytext'|
163       . (' ' x (27 - length($keytext)))
164       . qq| => '$text',\n|;
165   }
166
167   print FH q|};
168
169 $self->{subs} = {
170 |;
171
172   foreach $key (sort keys %subrt) {
173     $text = $key;
174     $text =~ s/'/\\'/g;
175     $text =~ s/\\$/\\\\/;
176     print FH qq|  '$text'| . (' ' x (27 - length($text))) . qq| => '$text',\n|;
177   }
178
179   foreach $key (sort keys %submit) {
180     $text = ($self->{texts}{$key}) ? $self->{texts}{$key} : $key;
181     $text =~ s/'/\\'/g;
182     $text =~ s/\\$/\\\\/;
183
184     $english_sub = $key;
185     $english_sub =~ s/'/\\'/g;
186     $english_sub =~ s/\\$/\\\\/;
187     $english_sub = lc $key;
188
189     $translated_sub = lc $text;
190     $english_sub    =~ s/( |-|,)/_/g;
191     $translated_sub =~ s/( |-|,)/_/g;
192     print FH qq|  '$translated_sub'|
193       . (' ' x (27 - length($translated_sub)))
194       . qq| => '$english_sub',\n|;
195   }
196
197   print FH q|};
198
199 1;
200 |;
201
202   close FH;
203
204 }
205
206 #foreach $file (@htmltemplates) {
207 #  converthtmlfile($file);
208 #}
209
210 # now print out all
211
212 open FH, ">all" or die "$! : all";
213
214 print FH q|#!/usr/bin/perl
215
216 # These are all the texts to build the translations files.
217 # The file has the form of 'english text'  => 'foreign text',
218 # you can add the translation in this file or in the 'missing' file
219 # run locales.pl from this directory to rebuild the translation files
220
221 $self->{texts} = {
222 |;
223
224 foreach $key (sort keys %alllocales) {
225   $text = $self->{texts}{$key};
226
227   $count++;
228
229   $text =~ s/'/\\'/g;
230   $text =~ s/\\$/\\\\/;
231   $key  =~ s/'/\\'/g;
232   $key  =~ s/\\$/\\\\/;
233
234   unless ($text) {
235     $notext++;
236     push @missing, $key;
237   }
238
239   print FH qq|  '$key'| . (' ' x (27 - length($key))) . qq| => '$text',\n|;
240
241 }
242
243 print FH q|};
244
245 1;
246 |;
247
248 close FH;
249
250 if (@missing) {
251   open FH, ">missing" or die "$! : missing";
252
253   print FH q|#!/usr/bin/perl
254
255 # add the missing texts and run locales.pl to rebuild
256
257 $missing = {
258 |;
259
260   foreach $text (@missing) {
261     print FH qq|  '$text'| . (' ' x (27 - length($text))) . qq| => '',\n|;
262   }
263
264   print FH q|};
265
266 1;
267 |;
268
269   close FH;
270
271 }
272
273 @lost = ();
274
275 if (-f "lost") {
276   require "lost";
277   unlink "lost";
278 }
279
280 while (($text, $translation) = each %old_texts) {
281   next if ($alllocales{$text});
282
283   push @lost, { 'text' => $text, 'translation' => $translation };
284 }
285
286 if (scalar @lost) {
287   splice @lost, 0, (scalar @lost - 50) if (scalar @lost > 50);
288
289   open FH, ">lost";
290   print FH "#!/usr/bin/perl\n\n" .
291     "# The last 50 texts that have been removed.\n" .
292     "# This file will be auto-generated by locales.pl. Do not edit it.\n\n" .
293     "\@lost = (\n";
294
295   foreach $entry (@lost) {
296     $entry->{text}        =~ s/\'/\\\'/g;
297     $entry->{translation} =~ s/\'/\\\'/g;
298     print FH "  { 'text' => '$entry->{text}', 'translation' => '$entry->{translation}' },\n";
299   }
300
301   print FH ");\n\n1;\n";
302   close FH;
303 }
304
305 open(FH, "LANGUAGE");
306 @language = <FH>;
307 close(FH);
308 $trlanguage = $language[0];
309 chomp $trlanguage;
310
311 if ($opt_c) {
312   search_unused_htmlfiles();
313   search_translated_htmlfiles_wo_master();
314 }
315
316 $per = sprintf("%.1f", ($count - $notext) / $count * 100);
317 print "\n$trlanguage - ${per}%";
318 print " - $notext/$count missing" if $notext;
319 print "\n";
320
321 exit;
322
323 # eom
324
325 sub extract_text_between_parenthesis {
326   my ($fh, $line) = @_;
327   my ($inside_string, $pos, $text, $quote_next) = (undef, 0, "", 0);
328
329   while (1) {
330     if (length($line) <= $pos) {
331       $line = <$fh>;
332       return ($text, "") unless ($line);
333       $pos = 0;
334     }
335
336     my $cur_char = substr($line, $pos, 1);
337
338     if (!$inside_string) {
339       if ((length($line) >= ($pos + 3)) && (substr($line, $pos, 2)) eq "qq") {
340         $inside_string = substr($line, $pos + 2, 1);
341         $pos += 2;
342
343       } elsif ((length($line) >= ($pos + 2)) &&
344                (substr($line, $pos, 1) eq "q")) {
345         $inside_string = substr($line, $pos + 1, 1);
346         $pos++;
347
348       } elsif (($cur_char eq '"') || ($cur_char eq '\'')) {
349         $inside_string = $cur_char;
350
351       } elsif (($cur_char eq ")") || ($cur_char eq ',')) {
352         return ($text, substr($line, $pos + 1));
353       }
354
355     } else {
356       if ($quote_next) {
357         $text .= $cur_char;
358         $quote_next = 0;
359
360       } elsif ($cur_char eq '\\') {
361         $text .= $cur_char;
362         $quote_next = 1;
363
364       } elsif ($cur_char eq $inside_string) {
365         undef($inside_string);
366
367       } else {
368         $text .= $cur_char;
369
370       }
371     }
372     $pos++;
373   }
374 }
375
376 sub scanfile {
377   my $file = shift;
378   my $dont_include_subs = shift;
379   my $scanned_files = shift;
380
381   # sanitize file
382   $file =~ s=/+=/=g;
383
384   $scanned_files = {} unless ($scanned_files);
385   return if ($scanned_files->{$file});
386   $scanned_files->{$file} = 1;
387
388   if (!defined $cached{$file}) {
389
390     return unless (-f "$file");
391
392     my $fh = new FileHandle;
393     open $fh, "$file" or die "$! : $file";
394
395     my ($is_submit, $line_no, $sub_line_no) = (0, 0, 0);
396
397     while (<$fh>) {
398       $line_no++;
399
400       # is this another file
401       if (/require\s+\W.*\.pl/) {
402         my $newfile = $&;
403         $newfile =~ s/require\s+\W//;
404         $newfile =~ s|bin/mozilla||;
405 #         &scanfile("$bindir/$newfile", 0, $scanned_files);
406          $cached{$file}{scan}{"$bindir/$newfile"} = 1;
407       } elsif (/use\s+SL::(.*?);/) {
408         my $module =  $1;
409         $module    =~ s|::|/|g;
410 #         &scanfile("../../SL/${1}.pm", 1, $scanned_files);
411         $cached{$file}{scannosubs}{"../../SL/${module}.pm"} = 1;
412       }
413
414       # is this a template call?
415       if (/parse_html_template2?\s*\(\s*[\"\']([\w\/]+)\s*[\"\']/) {
416         my $newfile = "$basedir/templates/webpages/$1_master.html";
417         if (/parse_html_template2/) {
418           print "E: " . strip_base($file) . " is still using 'parse_html_template2' for " . strip_base($newfile) . ".\n";
419         }
420         if (-f $newfile) {
421 #           &scanhtmlfile($newfile);
422 #           &converthtmlfile($newfile);
423            $cached{$file}{scanh}{$newfile} = 1;
424           print "." if $opt_v;
425         } elsif ($opt_c) {
426           print "W: missing HTML template: " . strip_base($newfile) . " (referenced from " . strip_base($file) . ")\n";
427         }
428       }
429
430       # is this a sub ?
431       if (/^sub /) {
432         next if ($dont_include_subs);
433         ($null, $subrt) = split / +/;
434 #        $subrt{$subrt} = 1;
435         $cached{$file}{subr}{$subrt} = 1;
436         next;
437       }
438
439       my $rc = 1;
440
441       while ($rc) {
442         if (/Locale/) {
443           unless (/^use /) {
444             my ($null, $country) = split /,/;
445             $country =~ s/^ +[\"\']//;
446             $country =~ s/[\"\'].*//;
447           }
448         }
449
450         my $postmatch = "";
451
452         # is it a submit button before $locale->
453         if (/$submitsearch/) {
454           $postmatch = "$'";
455           if ($` !~ /locale->text/) {
456             $is_submit   = 1;
457             $sub_line_no = $line_no;
458           }
459         }
460
461         my ($found) = /locale->text.*?\(/;
462         my $postmatch = "$'";
463
464         if ($found) {
465           my $string;
466           ($string, $_) = extract_text_between_parenthesis($fh, $postmatch);
467           $postmatch = $_;
468
469           # if there is no $ in the string record it
470           unless (($string =~ /\$\D.*/) || ("" eq $string)) {
471
472             # this guarantees one instance of string
473 #            $locale{$string} = 1;
474             $cached{$file}{locale}{$string} = 1;
475
476             # this one is for all the locales
477 #            $alllocales{$string} = 1;
478             $cached{$file}{all}{$string} = 1;
479
480             # is it a submit button before $locale->
481             if ($is_submit) {
482 #              $submit{$string} = 1;
483               $cached{$file}{submit}{$string} = 1;
484             }
485           }
486         } elsif ($postmatch =~ />/) {
487           $is_submit = 0;
488         }
489
490         # exit loop if there are no more locales on this line
491         ($rc) = ($postmatch =~ /locale->text/);
492
493         if (   ($postmatch =~ />/)
494             || (!$found && ($sub_line_no != $line_no) && />/)) {
495           $is_submit = 0;
496         }
497       }
498     }
499
500     close($fh);
501
502   }
503
504   map { $alllocales{$_} = 1 }   keys %{$cached{$file}{all}};
505   map { $locale{$_} = 1 }       keys %{$cached{$file}{locale}};
506   map { $submit{$_} = 1 }       keys %{$cached{$file}{submit}};
507   map { $subrt{$_} = 1 }        keys %{$cached{$file}{subr}};
508   map { &scanfile($_, 0, $scanned_files) } keys %{$cached{$file}{scan}};
509   map { &scanfile($_, 1, $scanned_files) } keys %{$cached{$file}{scannosubs}};
510   map { &scanhtmlfile($_)  }    keys %{$cached{$file}{scanh}};
511
512   @referenced_html_files{keys %{$cached{$file}{scanh}}} = (1) x scalar keys %{$cached{$file}{scanh}};
513 }
514
515 sub scanmenu {
516   my $file = shift;
517
518   my $fh = new FileHandle;
519   open $fh, "$file" or die "$! : $file";
520
521   my @a = grep m/^\[/, <$fh>;
522   close($fh);
523
524   # strip []
525   grep { s/(\[|\])//g } @a;
526
527   foreach my $item (@a) {
528     @b = split /--/, $item;
529     foreach $string (@b) {
530       chomp $string;
531       $locale{$string}     = 1;
532       $alllocales{$string} = 1;
533     }
534   }
535
536 }
537
538 sub scanhtmlfile {
539   local *IN;
540
541   if (!defined $cached{$_[0]}) {
542     my %plugins = ( 'loaded' => { }, 'needed' => { } );
543
544     open(IN, $_[0]) || die $_[0];
545
546     my $copying = 0;
547     my $issubmit = 0;
548     my $text = "";
549     while (my $line = <IN>) {
550       chomp($line);
551
552       while ($line =~ m/\[\%[^\w]*use[^\w]+(\w+)[^\w]*?\%\]/gi) {
553         $plugins{loaded}->{$1} = 1;
554       }
555
556       while ($line =~ m/\[\%[^\w]*(\w+)\.\w+\(/g) {
557         my $plugin = $1;
558         $plugins{needed}->{$plugin} = 1 if (first { $_ eq $plugin } qw(HTML LxERP JavaScript MultiColumnIterator));
559       }
560
561       while ("" ne $line) {
562         if (!$copying) {
563           if ($line =~ m|<translate>|i) {
564             my $eom = $+[0];
565             if ($` =~ /$submitsearch/) {
566               $issubmit = 1
567             }
568             substr($line, 0, $eom) = "";
569             $copying = 1;
570           } else {
571             $line = "";
572           }
573
574         } else {
575           if ($line =~ m|</translate>|i) {
576             $text .= $`;
577             substr($line, 0, $+[0]) = "";
578             $text =~ s/\s+/ /g;
579
580             $copying = 0;
581             if ($issubmit) {
582   #            $submit{$text} = 1;
583                $cached{$_[0]}{submit}{$text} = 1;
584               $issubmit = 0;
585             }
586   #          $alllocales{$text} = 1;
587              $cached{$_[0]}{all}{$text} = 1;
588   #          $htmllocale{$text} = 1;
589              $cached{$_[0]}{html}{$text} = 1;
590             $text = "";
591
592           } else {
593             $text .= $line;
594             $line = "";
595           }
596         }
597       }
598     }
599
600     close(IN);
601
602     foreach my $plugin (keys %{ $plugins{needed} }) {
603       next if ($plugins{loaded}->{$plugin});
604       print "E: " . strip_base($_[0]) . " requires the Template plugin '$plugin', but is not loaded with '[\% USE $plugin \%]'.\n";
605     }
606
607     &converthtmlfile($_[0]);
608   }
609
610   # copy back into global arrays
611   map { $alllocales{$_} = 1 }  keys %{$cached{$_[0]}{all}};
612   map { $htmllocales{$_} = 1 } keys %{$cached{$_[0]}{html}};
613   map { $submit{$_} = 1 }      keys %{$cached{$_[0]}{submit}};
614 }
615
616 sub converthtmlfile {
617   local *IN;
618   local *OUT;
619
620   my $file = shift;
621
622   open(IN, $file) || die;
623
624   my $langcode = (split("/", getcwd()))[-1];
625   $file =~ s/_master.html$/_${langcode}.html/;
626
627   open(OUT, ">$file") || die;
628
629   my $copying = 0;
630   my $text = "";
631   while (my $line = <IN>) {
632     chomp($line);
633     if ("" eq $line) {
634       print(OUT "\n");
635       next;
636     }
637
638     while ("" ne $line) {
639       if (!$copying) {
640         if ($line =~ m|<translate>|i) {
641           print(OUT $`);
642           substr($line, 0, $+[0]) = "";
643           $copying = 1;
644           print(OUT "\n") if ("" eq $line);
645
646         } else {
647           print(OUT "${line}\n");
648           $line = "";
649         }
650
651       } else {
652         if ($line =~ m|</translate>|i) {
653           $text .= $`;
654           substr($line, 0, $+[0]) = "";
655           $text =~ s/\s+/ /g;
656           $copying = 0;
657           $alllocales{$text} = 1;
658           $htmllocale{$text} = 1;
659           print(OUT $self->{"texts"}{$text} || $text);
660           print(OUT "\n") if ("" eq $line);
661           $text = "";
662
663         } else {
664           $text .= $line;
665           $line = "";
666         }
667       }
668     }
669   }
670
671   close(IN);
672   close(OUT);
673 }
674
675 sub search_unused_htmlfiles {
676   my @unscanned_dirs = ('../../templates/webpages');
677
678   while (scalar @unscanned_dirs) {
679     my $dir = shift @unscanned_dirs;
680
681     foreach my $entry (<$dir/*>) {
682       if (-d $entry) {
683         push @unscanned_dirs, $entry;
684
685       } elsif (($entry =~ /_master.html$/) && -f $entry && !$referenced_html_files{$entry}) {
686         print "W: unused HTML template: " . strip_base($entry) . "\n";
687
688       }
689     }
690   }
691 }
692
693 sub search_translated_htmlfiles_wo_master {
694   my @unscanned_dirs = ('../../templates/webpages');
695
696   while (scalar @unscanned_dirs) {
697     my $dir = shift @unscanned_dirs;
698
699     foreach my $entry (<$dir/*>) {
700       if (-d $entry) {
701         push @unscanned_dirs, $entry;
702
703       } elsif (($entry =~ /_[a-z]+\.html$/) && ($entry !~ /_master.html$/) && -f $entry) {
704         my $master =  $entry;
705         $master    =~ s/[a-z]+\.html$/master.html/;
706         if (! -f $master) {
707           print "W: translated HTML template without master: " . strip_base($entry) . "\n";
708         }
709       }
710     }
711   }
712 }
713
714 sub strip_base {
715   my $s =  "$_[0]";             # Create a copy of the string.
716
717   $s    =~ s|^../../||;
718   $s    =~ s|templates/webpages/||;
719
720   return $s;
721 }
722
723 __END__
724
725 =head1 NAME
726
727 locales.pl - Collect strings for translation in Lx-Office
728
729 =head1 SYNOPSIS
730
731 locales.pl [options]
732
733  Options:
734   -n, --no-custom-files  Do not process files whose name contains "_"
735   -c, --check-files      Run extended checks on HTML files
736   -v, --verbose          Be more verbose
737   -h, --help             Show this help
738
739 =head1 OPTIONS
740
741 =over 8
742
743 =item B<-n>, B<--no-custom-files>
744
745 Do not process files whose name contains "_", e.g. "custom_io.pl".
746
747 =item B<-c>, B<--check-files>
748
749 Run extended checks on the usage of templates. This can be used to
750 discover HTML templates that are never used as well as the usage of
751 non-existing HTML templates.
752
753 =item B<-v>, B<--verbose>
754
755 Be more verbose.
756
757 =back
758
759 =head1 DESCRIPTION
760
761 This script collects strings from Perl files, the menu.ini file and
762 HTML templates and puts them into the file "all" for translation.  It
763 also distributes those translations back to the individual files.
764
765 =cut