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