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', $basedir .'/templates/mobile_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   my $trans = $self->{more_texts}{$key} // $self->{texts}{$key};
 166   print $js_file ((!$first_entry ? ',' : '') ."\n". _double_quote($key) .':'. _double_quote($trans));
 167   $first_entry = 0;
 168 }
 169 print $js_file ("\n");
 170 print $js_file ('});'."\n");
 171 close($js_file);
 172
 173   foreach my $text (keys %$missing) {
 174     if ($locale{$text} || $htmllocale{$text}) {
 175       unless ($self->{texts}{$text}) {
 176         $self->{texts}{$text} = $missing->{$text};
 177       }
 178     }
 179   }
 180
 181
 182 # calc and generate missing
 183 # don't add missing ones if we have a translation in more_texts
 184 my @new_missing = grep { !$self->{more_texts}{$_} && !$self->{texts}{$_} } sort keys %alllocales;
 185
 186 if (@new_missing) {
 187   if ($opt_c) {
 188     my %existing_lc = map { (lc $_ => $_) } grep { $self->{texts}->{$_} } keys %{ $self->{texts} };
 189     foreach my $entry (@new_missing) {
 190       my $other = $existing_lc{lc $entry};
 191       print "W: No entry for '${entry}' exists, but there is one with different case: '${other}'\n" if $other;
 192     }
 193   }
 194
 195   if ($opt_f) {
 196     for my $string (@new_missing) {
 197       print "new string '$string' in files:\n";
 198       print join "",
 199         map   { "  $_\n"                  }
 200         apply { s{^(?:\.\./)+}{}          }
 201         grep  { $cached{$_}{all}{$string} }
 202         keys  %cached;
 203     }
 204   }
 205
 206   generate_file(
 207     file      => "$locales_dir/missing",
 208     header    => $MISSING_HEADER,
 209     data_name => '$missing',
 210     data_sub  => sub { _print_line($_, '', @_) for @new_missing },
 211   );
 212 }
 213
 214 # calc and generate lost
 215 while (my ($text, $translation) = each %old_texts) {
 216   next if ($alllocales{$text});
 217   push @lost, { 'text' => $text, 'translation' => $translation };
 218 }
 219
 220 if (scalar @lost) {
 221   splice @lost, 0, (scalar @lost - 50) if (scalar @lost > 50);
 222   generate_file(
 223     file      => "$locales_dir/lost",
 224     header    => $LOST_HEADER,
 225     delim     => '()',
 226     data_name => '@lost',
 227     data_sub  => sub {
 228       _print_line($_->{text}, $_->{translation}, @_, template => "  { 'text' => %s, 'translation' => %s },\n") for @lost;
 229     },
 230   );
 231 }
 232
 233 my $trlanguage = slurp("$locales_dir/LANGUAGE");
 234 chomp $trlanguage;
 235
 236 search_unused_htmlfiles() if $opt_c;
 237
 238 my $count  = scalar keys %alllocales;
 239 my $notext = scalar @new_missing;
 240 my $per    = sprintf("%.1f", ($count - $notext) / $count * 100);
 241 print "\n$trlanguage - ${per}%";
 242 print " - $notext/$count missing" if $notext;
 243 print "\n";
 244
 245 exit;
 246
 247 # eom
 248
 249 sub init {
 250   $ALL_HEADER = <<EOL;
 251 # These are all the texts to build the translations files.
 252 # The file has the form of 'english text'  => 'foreign text',
 253 # you can add the translation in this file or in the 'missing' file
 254 # run locales.pl from this directory to rebuild the translation files
 255 EOL
 256   $MISSING_HEADER = <<EOL;
 257 # add the missing texts and run locales.pl to rebuild
 258 EOL
 259   $LOST_HEADER  = <<EOL;
 260 # The last 50 text strings, that have been removed.
 261 # This file has been auto-generated by locales.pl. Please don't edit!
 262 EOL
 263 }
 264
 265 sub parse_args {
 266   my ($help, $man);
 267
 268   my ($opt_no_c, $ignore_for_compatiblity);
 269
 270   GetOptions(
 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_name = $1;
 438         if (/parse_html_template2/) {
 439           print "E: " . strip_base($file) . " is still using 'parse_html_template2' for $new_file_name.html.\n";
 440         }
 441
 442         my $found_one = 0;
 443         for my $space (qw(webpages mobile_webpages)) {
 444           for my $ext (qw(html js json)) {
 445             my $new_file = "$basedir/templates/$space/$new_file_name.$ext";
 446             if (-f $new_file) {
 447               $cached{$file}{scanh}{$new_file} = 1;
 448               print "." if $opt_v;
 449               $found_one = 1;
 450             }
 451           }
 452         }
 453
 454         if ($opt_c && !$found_one) {
 455           print "W: missing HTML template: $new_file_name.{html,json,js} (referenced from " . strip_base($file) . ")\n";
 456         }
 457       }
 458
 459       my $rc = 1;
 460
 461       while ($rc) {
 462         if (/Locale/) {
 463           unless (/^use /) {
 464             my ($null, $country) = split(/,/);
 465             $country =~ s/^ +[\"\']//;
 466             $country =~ s/[\"\'].*//;
 467           }
 468         }
 469
 470         my $postmatch = "";
 471
 472         # is it a submit button before $locale->
 473         if (/$submitsearch/) {
 474           $postmatch = "$'";
 475           if ($` !~ /locale->text/) {
 476             $is_submit   = 1;
 477             $sub_line_no = $line_no;
 478           }
 479         }
 480
 481         my $found;
 482         if (/ (?: locale->text | \b t8 ) \b .*? \(/x) {
 483           $found     = 1;
 484           $postmatch = "$'";
 485         }
 486
 487         if ($found) {
 488           my $string;
 489           ($string, $_) = extract_text_between_parenthesis($fh, $postmatch);
 490           $postmatch = $_;
 491
 492           # if there is no $ in the string record it
 493           unless (($string =~ /\$\D.*/) || ("" eq $string)) {
 494
 495             # this guarantees one instance of string
 496             $cached{$file}{locale}{$string} = 1;
 497
 498             # this one is for all the locales
 499             $cached{$file}{all}{$string} = 1;
 500
 501             # is it a submit button before $locale->
 502             if ($is_submit) {
 503               $cached{$file}{submit}{$string} = 1;
 504             }
 505           }
 506         } elsif ($postmatch =~ />/) {
 507           $is_submit = 0;
 508         }
 509
 510         # exit loop if there are no more locales on this line
 511         ($rc) = ($postmatch =~ /locale->text | \b t8/x);
 512
 513         if (   ($postmatch =~ />/)
 514             || (!$found && ($sub_line_no != $line_no) && />/)) {
 515           $is_submit = 0;
 516         }
 517       }
 518     }
 519
 520     close($fh);
 521
 522   }
 523
 524   $alllocales{$_} = 1             for keys %{$cached{$file}{all}};
 525   $locale{$_}     = 1             for keys %{$cached{$file}{locale}};
 526   $submit{$_}     = 1             for keys %{$cached{$file}{submit}};
 527
 528   scanfile($_, 0, $scanned_files) for keys %{$cached{$file}{scan}};
 529   scanfile($_, 1, $scanned_files) for keys %{$cached{$file}{scannosubs}};
 530   scanhtmlfile($_)                for keys %{$cached{$file}{scanh}};
 531
 532   $referenced_html_files{$_} = 1  for keys %{$cached{$file}{scanh}};
 533 }
 534
 535 sub scanmenu {
 536   my $file = shift;
 537
 538   my $menu = SL::YAML::LoadFile($file);
 539
 540   for my $node (@$menu) {
 541     # possible for override files
 542     next unless exists $node->{name};
 543
 544     $locale{$node->{name}}     = 1;
 545     $alllocales{$node->{name}} = 1;
 546     $cached{$file}{all}{$node->{name}} = 1;
 547   }
 548 }
 549
 550 sub scandbupgrades {
 551   # we only need to do this for auth atm, because only auth scripts can include new rights, which are translateable
 552   my $auth = 1;
 553
 554   my $dbu = SL::DBUpgrade2->new(auth => $auth, path => SL::System::Process->exe_dir . '/sql/Pg-upgrade2-auth');
 555
 556   for my $upgrade ($dbu->sort_dbupdate_controls) {
 557     for my $string (@{ $upgrade->{locales} || [] }) {
 558       $locale{$string}     = 1;
 559       $alllocales{$string} = 1;
 560     $cached{$upgrade->{tag}}{all}{$string} = 1;
 561     }
 562   }
 563 }
 564
 565 sub unescape_template_string {
 566   my $in =  "$_[0]";
 567   $in    =~ s/\\(.)/$1/g;
 568   return $in;
 569 }
 570
 571 sub scanhtmlfile {
 572   my ($file) = @_;
 573
 574   return if defined $cached{$file};
 575
 576   my $template_space = $file =~ m{templates/(\w+)/} ? $1 : 'webpages';
 577
 578   my %plugins = ( 'loaded' => { }, 'needed' => { } );
 579
 580   my $fh;
 581   if (!open($fh, '<:encoding(utf8)', $file)) {
 582     print "E: template file '$file' not found\n";
 583     return;
 584   }
 585
 586   my $copying  = 0;
 587   my $issubmit = 0;
 588   my $text     = "";
 589   while (my $line = <$fh>) {
 590     chomp($line);
 591
 592     while ($line =~ m/\[\%[^\w]*use[^\w]+(\w+)[^\w]*?\%\]/gi) {
 593       $plugins{loaded}->{$1} = 1;
 594     }
 595
 596     while ($line =~ m/\[\%[^\w]*(\w+)\.\w+\(/g) {
 597       my $plugin = $1;
 598       $plugins{needed}->{$plugin} = 1 if (first { $_ eq $plugin } qw(HTML LxERP JavaScript JSON L P));
 599     }
 600
 601     $plugins{needed}->{T8} = 1 if $line =~ m/\[\%.*\|.*\$T8/;
 602
 603     while ($line =~ m/(?:             # Start von Variante 1: LxERP.t8('...'); ohne darumliegende [% ... %]-Tags
 604                         (LxERP\.t8)\( #   LxERP.t8(                             ::Parameter $1::
 605                         ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $2::
 606                         (.*?)         #   Der zu übersetzende String            ::Parameter $3::
 607                         (?<!\\)\2     #   Ende des zu übersetzenden Strings
 608                       |               # Start von Variante 2: [% '...' | $T8 %]
 609                         \[\%          #   Template-Start-Tag
 610                         [\-~#]?       #   Whitespace-Unterdrückung
 611                         \s*           #   Optional beliebig viele Whitespace
 612                         ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $4::
 613                         (.*?)         #   Der zu übersetzende String            ::Parameter $5::
 614                         (?<!\\)\4     #   Ende des zu übersetzenden Strings
 615                         \s*\|\s*      #   Pipe-Zeichen mit optionalen Whitespace davor und danach
 616                         (\$T8)        #   Filteraufruf                          ::Parameter $6::
 617                         .*?           #   Optionale Argumente für den Filter
 618                         \s*           #   Whitespaces
 619                         [\-~#]?       #   Whitespace-Unterdrückung
 620                         \%\]          #   Template-Ende-Tag
 621                       )
 622                      /ix) {
 623       my $module = $1 || $6;
 624       my $string = $3 || $5;
 625       print "Found filter >>>$string<<<\n" if $debug;
 626       substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
 627
 628       $string                         = unescape_template_string($string);
 629       $cached{$file}{all}{$string}    = 1;
 630       $cached{$file}{html}{$string}   = 1;
 631       $cached{$file}{submit}{$string} = 1 if $PREMATCH =~ /$submitsearch/;
 632       $plugins{needed}->{T8}          = 1 if $module eq '$T8';
 633       $plugins{needed}->{LxERP}       = 1 if $module eq 'LxERP.t8';
 634     }
 635
 636     while ($line =~ m/\[\%          # Template-Start-Tag
 637                       [\-~#]*       # Whitespace-Unterdrückung
 638                       \s*           # Optional beliebig viele Whitespace
 639                       (?:           # Die erkannten Template-Direktiven
 640                         PROCESS
 641                       |
 642                         INCLUDE
 643                       )
 644                       \s+           # Mindestens ein Whitespace
 645                       [\'\"]?       # Anfang des Dateinamens
 646                       ([^\s]+)      # Beliebig viele Nicht-Whitespaces -- Dateiname
 647                       \.(html|js)   # Endung ".html" oder ".js", ansonsten kann es der Name eines Blocks sein
 648                      /ix) {
 649       my $new_file_name = "$basedir/templates/$template_space/$1.$2";
 650       $cached{$file}{scanh}{$new_file_name} = 1;
 651       substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
 652     }
 653   }
 654
 655   close($fh);
 656
 657   foreach my $plugin (keys %{ $plugins{needed} }) {
 658     next if ($plugins{loaded}->{$plugin});
 659     print "E: " . strip_base($file) . " requires the Template plugin '$plugin', but is not loaded with '[\% USE $plugin \%]'.\n";
 660   }
 661
 662   # copy back into global arrays
 663   $alllocales{$_} = 1            for keys %{$cached{$file}{all}};
 664   $locale{$_}     = 1            for keys %{$cached{$file}{html}};
 665   $submit{$_}     = 1            for keys %{$cached{$file}{submit}};
 666
 667   scanhtmlfile($_)               for keys %{$cached{$file}{scanh}};
 668
 669   $referenced_html_files{$_} = 1 for keys %{$cached{$file}{scanh}};
 670 }
 671
 672 sub scan_javascript_file {
 673   my ($file) = @_;
 674
 675   open(my $fh, '<:encoding(utf8)', $file) || die('can not open file: '. $file);
 676
 677   while( my $line = readline($fh) ) {
 678     while( $line =~ m/
 679                     \bk(?:ivi)?.t8
 680                     \s*
 681                     \(
 682                     \s*
 683                     ([\'\"])
 684                     (.*?)
 685                     (?<!\\)\1
 686                     /ixg )
 687     {
 688       my $text = unescape_template_string($2);
 689
 690       $jslocale{$text} = 1;
 691       $alllocales{$text} = 1;
 692     }
 693   }
 694
 695   close($fh);
 696 }
 697 sub search_unused_htmlfiles {
 698   my @unscanned_dirs = ('../../templates/webpages', '../../templates/mobile_webpages');
 699
 700   while (scalar @unscanned_dirs) {
 701     my $dir = shift @unscanned_dirs;
 702
 703     foreach my $entry (<$dir/*>) {
 704       if (-d $entry) {
 705         push @unscanned_dirs, $entry;
 706
 707       } elsif (!$ignore_unused_templates{strip_base($entry)} && -f $entry && !$referenced_html_files{$entry}) {
 708         print "W: unused HTML template: " . strip_base($entry) . "\n";
 709
 710       }
 711     }
 712   }
 713 }
 714
 715 sub strip_base {
 716   my $s =  "$_[0]";             # Create a copy of the string.
 717
 718   $s    =~ s|^../../||;
 719   $s    =~ s|templates/\w+/||;
 720
 721   return $s;
 722 }
 723
 724 sub _single_quote {
 725   my $val = shift;
 726   $val =~ s/(\'|\\$)/\\$1/g;
 727   return  "'" . $val .  "'";
 728 }
 729
 730 sub _double_quote {
 731   my $val = shift;
 732   $val =~ s/(\"|\\$)/\\$1/g;
 733   return  '"'. $val .'"';
 734 }
 735
 736 sub _print_line {
 737   my $key      = _single_quote(shift);
 738   my $text     = _single_quote(shift);
 739   my %params   = @_;
 740   my $template = $params{template} || qq|  %-29s => %s,\n|;
 741   my $fh       = $params{fh}       || croak 'need filehandle in _print_line';
 742
 743   print $fh sprintf $template, $key, $text;
 744 }
 745
 746 sub generate_file {
 747   my %params = @_;
 748
 749   my $file      = $params{file}   || croak 'need filename in generate_file';
 750   my $header    = $params{header};
 751   my $lines     = $params{data_sub};
 752   my $data_name = $params{data_name};
 753   my @delim     = split //, ($params{delim} || '{}');
 754
 755   open my $fh, '>:encoding(utf8)', $file or die "$! : $file";
 756
 757   print $fh "#!/usr/bin/perl\n# -*- coding: utf-8; -*-\n# vim: fenc=utf-8\n\nuse utf8;\n\n";
 758   print $fh $header, "\n" if $header;
 759   print $fh "$data_name = $delim[0]\n" if $data_name;
 760
 761   $lines->(fh => $fh);
 762
 763   print $fh qq|$delim[1];\n\n1;\n|;
 764   close $fh;
 765 }
 766
 767 __END__
 768
 769 =head1 NAME
 770
 771 locales.pl - Collect strings for translation in kivitendo
 772
 773 =head1 SYNOPSIS
 774
 775 locales.pl [options] lang_code
 776
 777  Options:
 778   -c, --check-files      Run extended checks on HTML files (default)
 779   -n, --no-check-files   Do not run extended checks on HTML files
 780   -f, --filenames        Show the filenames where new strings where found
 781   -v, --verbose          Be more verbose
 782   -h, --help             Show this help
 783
 784 =head1 OPTIONS
 785
 786 =over 8
 787
 788 =item B<-c>, B<--check-files>
 789
 790 Run extended checks on the usage of templates. This can be used to
 791 discover HTML templates that are never used as well as the usage of
 792 non-existing HTML templates. This is enabled by default.
 793
 794 =item B<-n>, B<--no-check-files>
 795
 796 Do not run extended checks on the usage of templates. See
 797 C<--no-check-files>.
 798
 799 =item B<-v>, B<--verbose>
 800
 801 Be more verbose.
 802
 803 =back
 804
 805 =head1 DESCRIPTION
 806
 807 This script collects strings from Perl files, the menu files and
 808 HTML templates and puts them into the file "all" for translation.
 809
 810 =cut