scripts/locales.pl

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