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