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