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