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