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