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