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