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   return if defined $cached{$file};
 523
 524   my %plugins = ( 'loaded' => { }, 'needed' => { } );
 525
 526   if (!open(IN, $file)) {
 527     print "E: template file '$file' not found\n";
 528     return;
 529   }
 530
 531   my $copying  = 0;
 532   my $issubmit = 0;
 533   my $text     = "";
 534   while (my $line = <IN>) {
 535     chomp($line);
 536
 537     while ($line =~ m/\[\%[^\w]*use[^\w]+(\w+)[^\w]*?\%\]/gi) {
 538       $plugins{loaded}->{$1} = 1;
 539     }
 540
 541     while ($line =~ m/\[\%[^\w]*(\w+)\.\w+\(/g) {
 542       my $plugin = $1;
 543       $plugins{needed}->{$plugin} = 1 if (first { $_ eq $plugin } qw(HTML LxERP JavaScript JSON L P));
 544     }
 545
 546     $plugins{needed}->{T8} = 1 if $line =~ m/\[\%.*\|.*\$T8/;
 547
 548     while ($line =~ m/(?:             # Start von Variante 1: LxERP.t8('...'); ohne darumliegende [% ... %]-Tags
 549                         (LxERP\.t8)\( #   LxERP.t8(                             ::Parameter $1::
 550                         ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $2::
 551                         (.*?)         #   Der zu übersetzende String            ::Parameter $3::
 552                         (?<!\\)\2     #   Ende des zu übersetzenden Strings
 553                       |               # Start von Variante 2: [% '...' | $T8 %]
 554                         \[\%          #   Template-Start-Tag
 555                         [\-~#]?       #   Whitespace-Unterdrückung
 556                         \s*           #   Optional beliebig viele Whitespace
 557                         ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $4::
 558                         (.*?)         #   Der zu übersetzende String            ::Parameter $5::
 559                         (?<!\\)\4     #   Ende des zu übersetzenden Strings
 560                         \s*\|\s*      #   Pipe-Zeichen mit optionalen Whitespace davor und danach
 561                         (\$T8)        #   Filteraufruf                          ::Parameter $6::
 562                         .*?           #   Optionale Argumente für den Filter
 563                         \s*           #   Whitespaces
 564                         [\-~#]?       #   Whitespace-Unterdrückung
 565                         \%\]          #   Template-Ende-Tag
 566                       )
 567                      /ix) {
 568       my $module = $1 || $6;
 569       my $string = $3 || $5;
 570       print "Found filter >>>$string<<<\n" if $debug;
 571       substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
 572
 573       $string                         = unescape_template_string($string);
 574       $cached{$file}{all}{$string}    = 1;
 575       $cached{$file}{html}{$string}   = 1;
 576       $cached{$file}{submit}{$string} = 1 if $PREMATCH =~ /$submitsearch/;
 577       $plugins{needed}->{T8}          = 1 if $module eq '$T8';
 578       $plugins{needed}->{LxERP}       = 1 if $module eq 'LxERP.t8';
 579     }
 580
 581     while ($line =~ m/\[\%          # Template-Start-Tag
 582                       [\-~#]?       # Whitespace-Unterdrückung
 583                       \s*           # Optional beliebig viele Whitespace
 584                       (?:           # Die erkannten Template-Direktiven
 585                         PROCESS
 586                       |
 587                         INCLUDE
 588                       )
 589                       \s+           # Mindestens ein Whitespace
 590                       [\'\"]?       # Anfang des Dateinamens
 591                       ([^\s]+)      # Beliebig viele Nicht-Whitespaces -- Dateiname
 592                       \.html        # Endung ".html", ansonsten kann es der Name eines Blocks sein
 593                      /ix) {
 594       my $new_file_name = "$basedir/templates/webpages/$1.html";
 595       $cached{$file}{scanh}{$new_file_name} = 1;
 596       substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
 597     }
 598   }
 599
 600   close(IN);
 601
 602   foreach my $plugin (keys %{ $plugins{needed} }) {
 603     next if ($plugins{loaded}->{$plugin});
 604     print "E: " . strip_base($file) . " requires the Template plugin '$plugin', but is not loaded with '[\% USE $plugin \%]'.\n";
 605   }
 606
 607   # copy back into global arrays
 608   $alllocales{$_} = 1            for keys %{$cached{$file}{all}};
 609   $locale{$_}     = 1            for keys %{$cached{$file}{html}};
 610   $submit{$_}     = 1            for keys %{$cached{$file}{submit}};
 611
 612   scanhtmlfile($_)               for keys %{$cached{$file}{scanh}};
 613
 614   $referenced_html_files{$_} = 1 for keys %{$cached{$file}{scanh}};
 615 }
 616
 617 sub scan_javascript_file {
 618   my ($file) = @_;
 619
 620   open(my $fh, $file) || die('can not open file: '. $file);
 621
 622   while( my $line = readline($fh) ) {
 623     while( $line =~ m/
 624                     kivi.t8
 625                     \s*
 626                     \(
 627                     \s*
 628                     ([\'\"])
 629                     (.*?)
 630                     (?<!\\)\1
 631                     /ixg )
 632     {
 633       my $text = unescape_template_string($2);
 634
 635       $jslocale{$text} = 1;
 636       $alllocales{$text} = 1;
 637     }
 638   }
 639
 640   close($fh);
 641 }
 642 sub search_unused_htmlfiles {
 643   my @unscanned_dirs = ('../../templates/webpages');
 644
 645   while (scalar @unscanned_dirs) {
 646     my $dir = shift @unscanned_dirs;
 647
 648     foreach my $entry (<$dir/*>) {
 649       if (-d $entry) {
 650         push @unscanned_dirs, $entry;
 651
 652       } elsif (($entry =~ /_master.html$/) && -f $entry && !$referenced_html_files{$entry}) {
 653         print "W: unused HTML template: " . strip_base($entry) . "\n";
 654
 655       }
 656     }
 657   }
 658 }
 659
 660 sub strip_base {
 661   my $s =  "$_[0]";             # Create a copy of the string.
 662
 663   $s    =~ s|^../../||;
 664   $s    =~ s|templates/webpages/||;
 665
 666   return $s;
 667 }
 668
 669 sub _single_quote {
 670   my $val = shift;
 671   $val =~ s/(\'|\\$)/\\$1/g;
 672   return  "'" . $val .  "'";
 673 }
 674
 675 sub _double_quote {
 676   my $val = shift;
 677   $val =~ s/(\"|\\$)/\\$1/g;
 678   return  '"'. $val .'"';
 679 }
 680
 681 sub _print_line {
 682   my $key      = _single_quote(shift);
 683   my $text     = _single_quote(shift);
 684   my %params   = @_;
 685   my $template = $params{template} || qq|  %-29s => %s,\n|;
 686   my $fh       = $params{fh}       || croak 'need filehandle in _print_line';
 687
 688   print $fh sprintf $template, $key, $text;
 689 }
 690
 691 sub generate_file {
 692   my %params = @_;
 693
 694   my $file      = $params{file}   || croak 'need filename in generate_file';
 695   my $header    = $params{header};
 696   my $lines     = $params{data_sub};
 697   my $data_name = $params{data_name};
 698   my @delim     = split //, ($params{delim} || '{}');
 699
 700   open my $fh, '>:encoding(utf8)', $file or die "$! : $file";
 701
 702   $charset =~ s/\r?\n//g;
 703   my $emacs_charset = lc $charset;
 704
 705   print $fh "#!/usr/bin/perl\n# -*- coding: $emacs_charset; -*-\n# vim: fenc=$charset\n\nuse utf8;\n\n";
 706   print $fh $header, "\n" if $header;
 707   print $fh "$data_name = $delim[0]\n" if $data_name;
 708
 709   $lines->(fh => $fh);
 710
 711   print $fh qq|$delim[1];\n\n1;\n|;
 712   close $fh;
 713 }
 714
 715 sub slurp {
 716   my $file = shift;
 717   do { local ( @ARGV, $/ ) = $file; <> }
 718 }
 719
 720 __END__
 721
 722 =head1 NAME
 723
 724 locales.pl - Collect strings for translation in kivitendo
 725
 726 =head1 SYNOPSIS
 727
 728 locales.pl [options] lang_code
 729
 730  Options:
 731   -n, --no-custom-files  Do not process files whose name contains "_"
 732   -c, --check-files      Run extended checks on HTML files
 733   -v, --verbose          Be more verbose
 734   -h, --help             Show this help
 735
 736 =head1 OPTIONS
 737
 738 =over 8
 739
 740 =item B<-n>, B<--no-custom-files>
 741
 742 Do not process files whose name contains "_", e.g. "custom_io.pl".
 743
 744 =item B<-c>, B<--check-files>
 745
 746 Run extended checks on the usage of templates. This can be used to
 747 discover HTML templates that are never used as well as the usage of
 748 non-existing HTML templates.
 749
 750 =item B<-v>, B<--verbose>
 751
 752 Be more verbose.
 753
 754 =back
 755
 756 =head1 DESCRIPTION
 757
 758 This script collects strings from Perl files, the menu.ini file and
 759 HTML templates and puts them into the file "all" for translation.
 760
 761 =cut