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