PriceRules: Merge Fehler - Kontextregeln bei Waren in den Tabs rendern
[kivitendo-erp.git] / scripts / 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 utf8;
10 use strict;
11
12 BEGIN {
13   unshift(@INC, 'modules/override'); # Use our own versions of various modules (e.g. YAML).
14   push   (@INC, 'modules/fallback'); # Only use our own versions of modules if there's no system version.
15 }
16
17 use Carp;
18 use Cwd;
19 use Data::Dumper;
20 use English;
21 use File::Slurp qw(slurp);
22 use FileHandle;
23 use Getopt::Long;
24 use IO::Dir;
25 use List::Util qw(first);
26 use Pod::Usage;
27
28 $OUTPUT_AUTOFLUSH = 1;
29
30 my $opt_v  = 0;
31 my $opt_n  = 0;
32 my $opt_c  = 0;
33 my $opt_f  = 0;
34 my $debug  = 0;
35
36 parse_args();
37
38 my $locale;
39 my $basedir      = "../..";
40 my $locales_dir  = ".";
41 my $bindir       = "$basedir/bin/mozilla";
42 my @progdirs     = ( "$basedir/SL" );
43 my @menufiles    = <${basedir}/menus/*.ini>;
44 my @javascript_dirs = ($basedir .'/js', $basedir .'/templates/webpages');
45 my $javascript_output_dir = $basedir .'/js';
46 my $submitsearch = qr/type\s*=\s*[\"\']?submit/i;
47 our $self        = {};
48 our $missing     = {};
49 our @lost        = ();
50
51 my %ignore_unused_templates = (
52   map { $_ => 1 } qw(ct/testpage.html generic/autocomplete.html oe/periodic_invoices_email.txt part/testpage.html t/render.html t/render.js task_server/failure_notification_email.txt)
53 );
54
55 my (%referenced_html_files, %locale, %htmllocale, %alllocales, %cached, %submit, %jslocale);
56 my ($ALL_HEADER, $MISSING_HEADER, $LOST_HEADER);
57
58 init();
59
60 sub find_files {
61   my ($top_dir_name) = @_;
62
63   my (@files, $finder);
64
65   $finder = sub {
66     my ($dir_name) = @_;
67
68     tie my %dir_h, 'IO::Dir', $dir_name;
69
70     push @files,   grep { -f } map { "${dir_name}/${_}" }                       keys %dir_h;
71     my @sub_dirs = grep { -d } map { "${dir_name}/${_}" } grep { ! m/^\.\.?$/ } keys %dir_h;
72
73     $finder->($_) for @sub_dirs;
74   };
75
76   $finder->($top_dir_name);
77
78   return @files;
79 }
80
81 sub merge_texts {
82 # overwrite existing entries with the ones from 'missing'
83   $self->{texts}->{$_} = $missing->{$_} for grep { $missing->{$_} } keys %alllocales;
84
85   # try to set missing entries from lost ones
86   my %lost_by_text = map { ($_->{text} => $_->{translation}) } @lost;
87   $self->{texts}->{$_} = $lost_by_text{$_} for grep { !$self->{texts}{$_} } keys %alllocales;
88 }
89
90 my @bindir_files = find_files($bindir);
91 my @progfiles    = map { m:^(.+)/([^/]+)$:; [ $2, $1 ]  } grep { /\.pl$/ && !/_custom/ } @bindir_files;
92 my @customfiles  = grep /_custom/, @bindir_files;
93
94 push @progfiles, map { m:^(.+)/([^/]+)$:; [ $2, $1 ] } grep { /\.pm$/ } map { find_files($_) } @progdirs;
95
96 # put customized files into @customfiles
97 my %dir_h;
98
99 if ($opt_n) {
100   @customfiles = ();
101 } else {
102   tie %dir_h, 'IO::Dir', $basedir;
103   push @menufiles, map { "$basedir/$_" } grep { /.*_menu.ini$/ } keys %dir_h;
104 }
105
106 my @dbplfiles;
107 foreach my $sub_dir ("Pg-upgrade2", "Pg-upgrade2-auth") {
108   my $dir = "$basedir/sql/$sub_dir";
109   tie %dir_h, 'IO::Dir', $dir;
110   push @dbplfiles, map { [ $_, $dir ] } grep { /\.pl$/ } keys %dir_h;
111 }
112
113 # slurp the translations in
114 if (-f "$locales_dir/all") {
115   require "$locales_dir/all";
116 }
117 if (-f "$locales_dir/missing") {
118   require "$locales_dir/missing" ;
119   unlink "$locales_dir/missing";
120 }
121 if (-f "$locales_dir/lost") {
122   require "$locales_dir/lost";
123   unlink "$locales_dir/lost";
124 }
125
126 my %old_texts = %{ $self->{texts} || {} };
127
128 handle_file(@{ $_ })       for @progfiles;
129 handle_file(@{ $_ })       for @dbplfiles;
130 scanmenu($_)               for @menufiles;
131
132 for my $file_name (grep { /\.(?:js|html)$/i } map({find_files($_)} @javascript_dirs)) {
133   scan_javascript_file($file_name);
134 }
135
136 # merge entries to translate with entries from files 'missing' and 'lost'
137 merge_texts();
138
139 # generate all
140 generate_file(
141   file      => "$locales_dir/all",
142   header    => $ALL_HEADER,
143   data_name => '$self->{texts}',
144   data_sub  => sub { _print_line($_, $self->{texts}{$_}, @_) for sort keys %alllocales },
145 );
146
147 open(my $js_file, '>:encoding(utf8)', $javascript_output_dir .'/locale/'. $locale .'.js') || die;
148 print $js_file 'namespace("kivi").setupLocale({';
149 my $first_entry = 1;
150 for my $key (sort(keys(%jslocale))) {
151   print $js_file ((!$first_entry ? ',' : '') ."\n". _double_quote($key) .':'. _double_quote($self->{texts}{$key}));
152   $first_entry = 0;
153 }
154 print $js_file ("\n");
155 print $js_file ('});'."\n");
156 close($js_file);
157
158   foreach my $text (keys %$missing) {
159     if ($locale{$text} || $htmllocale{$text}) {
160       unless ($self->{texts}{$text}) {
161         $self->{texts}{$text} = $missing->{$text};
162       }
163     }
164   }
165
166
167 # calc and generate missing
168 my @new_missing = grep { !$self->{texts}{$_} } sort keys %alllocales;
169
170 if (@new_missing) {
171   if ($opt_c) {
172     my %existing_lc = map { (lc $_ => $_) } grep { $self->{texts}->{$_} } keys %{ $self->{texts} };
173     foreach my $entry (@new_missing) {
174       my $other = $existing_lc{lc $entry};
175       print "W: No entry for '${entry}' exists, but there is one with different case: '${other}'\n" if $other;
176     }
177   }
178
179   if ($opt_f) {
180     for my $string (@new_missing) {
181       print "new string '$string' in files:\n";
182       for my $file (keys %cached) {
183         print "  $file", $/ if $cached{$file}{all}{$string};
184       }
185     }
186   }
187
188   generate_file(
189     file      => "$locales_dir/missing",
190     header    => $MISSING_HEADER,
191     data_name => '$missing',
192     data_sub  => sub { _print_line($_, '', @_) for @new_missing },
193   );
194 }
195
196 # calc and generate lost
197 while (my ($text, $translation) = each %old_texts) {
198   next if ($alllocales{$text});
199   push @lost, { 'text' => $text, 'translation' => $translation };
200 }
201
202 if (scalar @lost) {
203   splice @lost, 0, (scalar @lost - 50) if (scalar @lost > 50);
204   generate_file(
205     file      => "$locales_dir/lost",
206     header    => $LOST_HEADER,
207     delim     => '()',
208     data_name => '@lost',
209     data_sub  => sub {
210       _print_line($_->{text}, $_->{translation}, @_, template => "  { 'text' => %s, 'translation' => %s },\n") for @lost;
211     },
212   );
213 }
214
215 my $trlanguage = slurp("$locales_dir/LANGUAGE");
216 chomp $trlanguage;
217
218 search_unused_htmlfiles() if $opt_c;
219
220 my $count  = scalar keys %alllocales;
221 my $notext = scalar @new_missing;
222 my $per    = sprintf("%.1f", ($count - $notext) / $count * 100);
223 print "\n$trlanguage - ${per}%";
224 print " - $notext/$count missing" if $notext;
225 print "\n";
226
227 exit;
228
229 # eom
230
231 sub init {
232   $ALL_HEADER = <<EOL;
233 # These are all the texts to build the translations files.
234 # The file has the form of 'english text'  => 'foreign text',
235 # you can add the translation in this file or in the 'missing' file
236 # run locales.pl from this directory to rebuild the translation files
237 EOL
238   $MISSING_HEADER = <<EOL;
239 # add the missing texts and run locales.pl to rebuild
240 EOL
241   $LOST_HEADER  = <<EOL;
242 # The last 50 text strings, that have been removed.
243 # This file has been auto-generated by locales.pl. Please don't edit!
244 EOL
245 }
246
247 sub parse_args {
248   my ($help, $man);
249
250   my ($opt_no_c, $ignore_for_compatiblity);
251
252   GetOptions(
253     'no-custom-files' => \$opt_n,
254     'check-files'     => \$ignore_for_compatiblity,
255     'no-check-files'  => \$opt_no_c,
256     'verbose'         => \$opt_v,
257     'filenames'       => \$opt_f,
258     'help'            => \$help,
259     'man'             => \$man,
260     'debug'           => \$debug,
261   );
262
263   $opt_c = !$opt_no_c;
264
265   if ($help) {
266     pod2usage(1);
267     exit 0;
268   }
269
270   if ($man) {
271     pod2usage(-exitstatus => 0, -verbose => 2);
272     exit 0;
273   }
274
275   if (@ARGV) {
276     my $arg = shift @ARGV;
277     my $ok  = 0;
278     foreach my $dir ("../locale/$arg", "locale/$arg", "../$arg", $arg) {
279       next unless -d $dir && -f "$dir/all" && -f "$dir/LANGUAGE";
280
281       $locale = $arg;
282
283       $ok = chdir $dir;
284       last;
285     }
286
287     if (!$ok) {
288       print "The locale directory '$arg' could not be found.\n";
289       exit 1;
290     }
291
292   } elsif (!-f 'all' || !-f 'LANGUAGE') {
293     print "locales.pl was not called from a locale/* subdirectory,\n"
294       .   "and no locale directory name was given.\n";
295     exit 1;
296   }
297
298   $locale ||=  (grep { $_ } split m:/:, getcwd())[-1];
299   $locale   =~ s/\.+$//;
300 }
301
302 sub handle_file {
303   my ($file, $dir) = @_;
304   print "\n$file" if $opt_v;
305   %locale = ();
306   %submit = ();
307
308   &scanfile("$dir/$file");
309
310   # scan custom_{module}.pl or {login}_{module}.pl files
311   foreach my $customfile (@customfiles) {
312     if ($customfile =~ /_$file/) {
313       if (-f "$dir/$customfile") {
314         &scanfile("$dir/$customfile");
315       }
316     }
317   }
318
319   $file =~ s/\.pl//;
320 }
321
322 sub extract_text_between_parenthesis {
323   my ($fh, $line) = @_;
324   my ($inside_string, $pos, $text, $quote_next) = (undef, 0, "", 0);
325
326   while (1) {
327     if (length($line) <= $pos) {
328       $line = <$fh>;
329       return ($text, "") unless ($line);
330       $pos = 0;
331     }
332
333     my $cur_char = substr($line, $pos, 1);
334
335     if (!$inside_string) {
336       if ((length($line) >= ($pos + 3)) && (substr($line, $pos, 2)) eq "qq") {
337         $inside_string = substr($line, $pos + 2, 1);
338         $pos += 2;
339
340       } elsif ((length($line) >= ($pos + 2)) &&
341                (substr($line, $pos, 1) eq "q")) {
342         $inside_string = substr($line, $pos + 1, 1);
343         $pos++;
344
345       } elsif (($cur_char eq '"') || ($cur_char eq '\'')) {
346         $inside_string = $cur_char;
347
348       } elsif (($cur_char eq ")") || ($cur_char eq ',')) {
349         return ($text, substr($line, $pos + 1));
350       }
351
352     } else {
353       if ($quote_next) {
354         $text .= '\\' unless $cur_char eq "'";
355         $text .= $cur_char;
356         $quote_next = 0;
357
358       } elsif ($cur_char eq '\\') {
359         $quote_next = 1;
360
361       } elsif ($cur_char eq $inside_string) {
362         undef($inside_string);
363
364       } else {
365         $text .= $cur_char;
366
367       }
368     }
369     $pos++;
370   }
371 }
372
373 sub scanfile {
374   my $file = shift;
375   my $dont_include_subs = shift;
376   my $scanned_files = shift;
377
378   # sanitize file
379   $file =~ s=/+=/=g;
380
381   $scanned_files = {} unless ($scanned_files);
382   return if ($scanned_files->{$file});
383   $scanned_files->{$file} = 1;
384
385   if (!defined $cached{$file}) {
386
387     return unless (-f "$file");
388
389     my $fh = new FileHandle;
390     open $fh, '<:encoding(utf8)', $file or die "$! : $file";
391
392     my ($is_submit, $line_no, $sub_line_no) = (0, 0, 0);
393
394     while (<$fh>) {
395       last if /^\s*__END__/;
396
397       $line_no++;
398
399       # is this another file
400       if (/require\s+\W.*\.pl/) {
401         my $newfile = $&;
402         $newfile =~ s/require\s+\W//;
403         $newfile =~ s|bin/mozilla||;
404          $cached{$file}{scan}{"$bindir/$newfile"} = 1;
405       } elsif (/use\s+SL::([\w:]*)/) {
406         my $module =  $1;
407         $module    =~ s|::|/|g;
408         $cached{$file}{scannosubs}{"../../SL/${module}.pm"} = 1;
409       }
410
411       # Some calls to render() are split over multiple lines. Deal
412       # with that.
413       while (/(?:parse_html_template2?|render)\s*\( *$/) {
414         $_ .= <$fh>;
415         chomp;
416       }
417
418       # is this a template call?
419       if (/(?:parse_html_template2?|render)\s*\(\s*[\"\']([\w\/]+)\s*[\"\']/) {
420         my $new_file_base = "$basedir/templates/webpages/$1.";
421         if (/parse_html_template2/) {
422           print "E: " . strip_base($file) . " is still using 'parse_html_template2' for " . strip_base("${new_file_base}html") . ".\n";
423         }
424
425         my $found_one = 0;
426         foreach my $ext (qw(html js json)) {
427           my $new_file = "${new_file_base}${ext}";
428           if (-f $new_file) {
429             $cached{$file}{scanh}{$new_file} = 1;
430             print "." if $opt_v;
431             $found_one = 1;
432           }
433         }
434
435         if ($opt_c && !$found_one) {
436           print "W: missing HTML template: " . strip_base($new_file_base) . "{html,json,js} (referenced from " . strip_base($file) . ")\n";
437         }
438       }
439
440       my $rc = 1;
441
442       while ($rc) {
443         if (/Locale/) {
444           unless (/^use /) {
445             my ($null, $country) = split(/,/);
446             $country =~ s/^ +[\"\']//;
447             $country =~ s/[\"\'].*//;
448           }
449         }
450
451         my $postmatch = "";
452
453         # is it a submit button before $locale->
454         if (/$submitsearch/) {
455           $postmatch = "$'";
456           if ($` !~ /locale->text/) {
457             $is_submit   = 1;
458             $sub_line_no = $line_no;
459           }
460         }
461
462         my $found;
463         if (/ (?: locale->text | \b t8 ) \b .*? \(/x) {
464           $found     = 1;
465           $postmatch = "$'";
466         }
467
468         if ($found) {
469           my $string;
470           ($string, $_) = extract_text_between_parenthesis($fh, $postmatch);
471           $postmatch = $_;
472
473           # if there is no $ in the string record it
474           unless (($string =~ /\$\D.*/) || ("" eq $string)) {
475
476             # this guarantees one instance of string
477             $cached{$file}{locale}{$string} = 1;
478
479             # this one is for all the locales
480             $cached{$file}{all}{$string} = 1;
481
482             # is it a submit button before $locale->
483             if ($is_submit) {
484               $cached{$file}{submit}{$string} = 1;
485             }
486           }
487         } elsif ($postmatch =~ />/) {
488           $is_submit = 0;
489         }
490
491         # exit loop if there are no more locales on this line
492         ($rc) = ($postmatch =~ /locale->text | \b t8/x);
493
494         if (   ($postmatch =~ />/)
495             || (!$found && ($sub_line_no != $line_no) && />/)) {
496           $is_submit = 0;
497         }
498       }
499     }
500
501     close($fh);
502
503   }
504
505   $alllocales{$_} = 1             for keys %{$cached{$file}{all}};
506   $locale{$_}     = 1             for keys %{$cached{$file}{locale}};
507   $submit{$_}     = 1             for keys %{$cached{$file}{submit}};
508
509   scanfile($_, 0, $scanned_files) for keys %{$cached{$file}{scan}};
510   scanfile($_, 1, $scanned_files) for keys %{$cached{$file}{scannosubs}};
511   scanhtmlfile($_)                for keys %{$cached{$file}{scanh}};
512
513   $referenced_html_files{$_} = 1  for keys %{$cached{$file}{scanh}};
514 }
515
516 sub scanmenu {
517   my $file = shift;
518
519   my $fh = new FileHandle;
520   open $fh, '<:encoding(utf8)', $file or die "$! : $file";
521
522   my @a = grep m/^\[/, <$fh>;
523   close($fh);
524
525   # strip []
526   grep { s/(\[|\])//g } @a;
527
528   foreach my $item (@a) {
529     my @b = split /--/, $item;
530     foreach my $string (@b) {
531       chomp $string;
532       $locale{$string}     = 1;
533       $alllocales{$string} = 1;
534     }
535   }
536
537 }
538
539 sub unescape_template_string {
540   my $in =  "$_[0]";
541   $in    =~ s/\\(.)/$1/g;
542   return $in;
543 }
544
545 sub scanhtmlfile {
546   local *IN;
547
548   my $file = shift;
549
550   return if defined $cached{$file};
551
552   my %plugins = ( 'loaded' => { }, 'needed' => { } );
553
554   if (!open(IN, '<:encoding(utf8)', $file)) {
555     print "E: template file '$file' not found\n";
556     return;
557   }
558
559   my $copying  = 0;
560   my $issubmit = 0;
561   my $text     = "";
562   while (my $line = <IN>) {
563     chomp($line);
564
565     while ($line =~ m/\[\%[^\w]*use[^\w]+(\w+)[^\w]*?\%\]/gi) {
566       $plugins{loaded}->{$1} = 1;
567     }
568
569     while ($line =~ m/\[\%[^\w]*(\w+)\.\w+\(/g) {
570       my $plugin = $1;
571       $plugins{needed}->{$plugin} = 1 if (first { $_ eq $plugin } qw(HTML LxERP JavaScript JSON L P));
572     }
573
574     $plugins{needed}->{T8} = 1 if $line =~ m/\[\%.*\|.*\$T8/;
575
576     while ($line =~ m/(?:             # Start von Variante 1: LxERP.t8('...'); ohne darumliegende [% ... %]-Tags
577                         (LxERP\.t8)\( #   LxERP.t8(                             ::Parameter $1::
578                         ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $2::
579                         (.*?)         #   Der zu übersetzende String            ::Parameter $3::
580                         (?<!\\)\2     #   Ende des zu übersetzenden Strings
581                       |               # Start von Variante 2: [% '...' | $T8 %]
582                         \[\%          #   Template-Start-Tag
583                         [\-~#]?       #   Whitespace-Unterdrückung
584                         \s*           #   Optional beliebig viele Whitespace
585                         ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $4::
586                         (.*?)         #   Der zu übersetzende String            ::Parameter $5::
587                         (?<!\\)\4     #   Ende des zu übersetzenden Strings
588                         \s*\|\s*      #   Pipe-Zeichen mit optionalen Whitespace davor und danach
589                         (\$T8)        #   Filteraufruf                          ::Parameter $6::
590                         .*?           #   Optionale Argumente für den Filter
591                         \s*           #   Whitespaces
592                         [\-~#]?       #   Whitespace-Unterdrückung
593                         \%\]          #   Template-Ende-Tag
594                       )
595                      /ix) {
596       my $module = $1 || $6;
597       my $string = $3 || $5;
598       print "Found filter >>>$string<<<\n" if $debug;
599       substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
600
601       $string                         = unescape_template_string($string);
602       $cached{$file}{all}{$string}    = 1;
603       $cached{$file}{html}{$string}   = 1;
604       $cached{$file}{submit}{$string} = 1 if $PREMATCH =~ /$submitsearch/;
605       $plugins{needed}->{T8}          = 1 if $module eq '$T8';
606       $plugins{needed}->{LxERP}       = 1 if $module eq 'LxERP.t8';
607     }
608
609     while ($line =~ m/\[\%          # Template-Start-Tag
610                       [\-~#]?       # Whitespace-Unterdrückung
611                       \s*           # Optional beliebig viele Whitespace
612                       (?:           # Die erkannten Template-Direktiven
613                         PROCESS
614                       |
615                         INCLUDE
616                       )
617                       \s+           # Mindestens ein Whitespace
618                       [\'\"]?       # Anfang des Dateinamens
619                       ([^\s]+)      # Beliebig viele Nicht-Whitespaces -- Dateiname
620                       \.(html|js)   # Endung ".html" oder ".js", ansonsten kann es der Name eines Blocks sein
621                      /ix) {
622       my $new_file_name = "$basedir/templates/webpages/$1.$2";
623       $cached{$file}{scanh}{$new_file_name} = 1;
624       substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
625     }
626   }
627
628   close(IN);
629
630   foreach my $plugin (keys %{ $plugins{needed} }) {
631     next if ($plugins{loaded}->{$plugin});
632     print "E: " . strip_base($file) . " requires the Template plugin '$plugin', but is not loaded with '[\% USE $plugin \%]'.\n";
633   }
634
635   # copy back into global arrays
636   $alllocales{$_} = 1            for keys %{$cached{$file}{all}};
637   $locale{$_}     = 1            for keys %{$cached{$file}{html}};
638   $submit{$_}     = 1            for keys %{$cached{$file}{submit}};
639
640   scanhtmlfile($_)               for keys %{$cached{$file}{scanh}};
641
642   $referenced_html_files{$_} = 1 for keys %{$cached{$file}{scanh}};
643 }
644
645 sub scan_javascript_file {
646   my ($file) = @_;
647
648   open(my $fh, '<:encoding(utf8)', $file) || die('can not open file: '. $file);
649
650   while( my $line = readline($fh) ) {
651     while( $line =~ m/
652                     \bk(?:ivi)?.t8
653                     \s*
654                     \(
655                     \s*
656                     ([\'\"])
657                     (.*?)
658                     (?<!\\)\1
659                     /ixg )
660     {
661       my $text = unescape_template_string($2);
662
663       $jslocale{$text} = 1;
664       $alllocales{$text} = 1;
665     }
666   }
667
668   close($fh);
669 }
670 sub search_unused_htmlfiles {
671   my @unscanned_dirs = ('../../templates/webpages');
672
673   while (scalar @unscanned_dirs) {
674     my $dir = shift @unscanned_dirs;
675
676     foreach my $entry (<$dir/*>) {
677       if (-d $entry) {
678         push @unscanned_dirs, $entry;
679
680       } elsif (!$ignore_unused_templates{strip_base($entry)} && -f $entry && !$referenced_html_files{$entry}) {
681         print "W: unused HTML template: " . strip_base($entry) . "\n";
682
683       }
684     }
685   }
686 }
687
688 sub strip_base {
689   my $s =  "$_[0]";             # Create a copy of the string.
690
691   $s    =~ s|^../../||;
692   $s    =~ s|templates/webpages/||;
693
694   return $s;
695 }
696
697 sub _single_quote {
698   my $val = shift;
699   $val =~ s/(\'|\\$)/\\$1/g;
700   return  "'" . $val .  "'";
701 }
702
703 sub _double_quote {
704   my $val = shift;
705   $val =~ s/(\"|\\$)/\\$1/g;
706   return  '"'. $val .'"';
707 }
708
709 sub _print_line {
710   my $key      = _single_quote(shift);
711   my $text     = _single_quote(shift);
712   my %params   = @_;
713   my $template = $params{template} || qq|  %-29s => %s,\n|;
714   my $fh       = $params{fh}       || croak 'need filehandle in _print_line';
715
716   print $fh sprintf $template, $key, $text;
717 }
718
719 sub generate_file {
720   my %params = @_;
721
722   my $file      = $params{file}   || croak 'need filename in generate_file';
723   my $header    = $params{header};
724   my $lines     = $params{data_sub};
725   my $data_name = $params{data_name};
726   my @delim     = split //, ($params{delim} || '{}');
727
728   open my $fh, '>:encoding(utf8)', $file or die "$! : $file";
729
730   print $fh "#!/usr/bin/perl\n# -*- coding: utf-8; -*-\n# vim: fenc=utf-8\n\nuse utf8;\n\n";
731   print $fh $header, "\n" if $header;
732   print $fh "$data_name = $delim[0]\n" if $data_name;
733
734   $lines->(fh => $fh);
735
736   print $fh qq|$delim[1];\n\n1;\n|;
737   close $fh;
738 }
739
740 __END__
741
742 =head1 NAME
743
744 locales.pl - Collect strings for translation in kivitendo
745
746 =head1 SYNOPSIS
747
748 locales.pl [options] lang_code
749
750  Options:
751   -n, --no-custom-files  Do not process files whose name contains "_"
752   -c, --check-files      Run extended checks on HTML files
753   -f, --filenames        Show the filenames where new strings where found
754   -v, --verbose          Be more verbose
755   -h, --help             Show this help
756
757 =head1 OPTIONS
758
759 =over 8
760
761 =item B<-n>, B<--no-custom-files>
762
763 Do not process files whose name contains "_", e.g. "custom_io.pl".
764
765 =item B<-c>, B<--check-files>
766
767 Run extended checks on the usage of templates. This can be used to
768 discover HTML templates that are never used as well as the usage of
769 non-existing HTML templates.
770
771 =item B<-v>, B<--verbose>
772
773 Be more verbose.
774
775 =back
776
777 =head1 DESCRIPTION
778
779 This script collects strings from Perl files, the menu.ini file and
780 HTML templates and puts them into the file "all" for translation.
781
782 =cut