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