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