scripts/locales.pl

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