Merge branch 'constraints_in_tax_and_taxkeys'
[kivitendo-erp.git] / scripts / locales.pl
index a0314d8..5e6a8a5 100755 (executable)
@@ -6,17 +6,19 @@
 # this version of locles processes not only all required .pl files
 # but also all parse_html_templated files.
 
+use utf8;
 use strict;
 
+use Carp;
 use Data::Dumper;
 use English;
+use File::Slurp qw(slurp);
 use FileHandle;
 use Getopt::Long;
+use IO::Dir;
 use List::Util qw(first);
 use POSIX;
 use Pod::Usage;
-use Carp;
-use File::Slurp qw(slurp);
 
 $OUTPUT_AUTOFLUSH = 1;
 
@@ -30,49 +32,75 @@ parse_args();
 my $basedir      = "../..";
 my $locales_dir  = ".";
 my $bindir       = "$basedir/bin/mozilla";
+my @progdirs     = ( "$basedir/SL" );
 my $dbupdir      = "$basedir/sql/Pg-upgrade";
 my $dbupdir2     = "$basedir/sql/Pg-upgrade2";
 my $menufile     = "menu.ini";
 my $submitsearch = qr/type\s*=\s*[\"\']?submit/i;
+our $self        = {};
+our $missing     = {};
+our @lost        = ();
 
 my (%referenced_html_files, %locale, %htmllocale, %alllocales, %cached, %submit);
 my ($ALL_HEADER, $MISSING_HEADER, $LOST_HEADER);
 
 init();
 
-opendir DIR, "$bindir" or die "$!";
-my @progfiles = grep { /\.pl$/ && !/(_custom|^\.)/ } readdir DIR;
-seekdir DIR, 0;
-my @customfiles = grep /_custom/, readdir DIR;
-closedir DIR;
+sub find_files {
+  my ($top_dir_name) = @_;
+
+  my (@files, $finder);
+
+  $finder = sub {
+    my ($dir_name) = @_;
+
+    tie my %dir_h, 'IO::Dir', $dir_name;
+
+    push @files,   grep { -f } map { "${dir_name}/${_}" }                       keys %dir_h;
+    my @sub_dirs = grep { -d } map { "${dir_name}/${_}" } grep { ! m/^\.\.?$/ } keys %dir_h;
+
+    $finder->($_) for @sub_dirs;
+  };
+
+  $finder->($top_dir_name);
+
+  return @files;
+}
+
+sub merge_texts {
+# overwrite existing entries with the ones from 'missing'
+  $self->{texts}->{$_} = $missing->{$_} for grep { $missing->{$_} } keys %alllocales;
+
+  # try to set missing entries from lost ones
+  my %lost_by_text = map { ($_->{text} => $_->{translation}) } @lost;
+  $self->{texts}->{$_} = $lost_by_text{$_} for grep { !$self->{texts}{$_} } keys %alllocales;
+}
+
+my @bindir_files = find_files($bindir);
+my @progfiles    = map { m:^(.+)/([^/]+)$:; [ $2, $1 ]  } grep { /\.pl$/ && !/_custom/ } @bindir_files;
+my @customfiles  = grep /_custom/, @bindir_files;
+
+push @progfiles, map { m:^(.+)/([^/]+)$:; [ $2, $1 ] } grep { /\.pm$/ } map { find_files($_) } @progdirs;
 
 # put customized files into @customfiles
-my @menufiles;
+my (@menufiles, %dir_h);
 
 if ($opt_n) {
   @customfiles = ();
   @menufiles   = ($menufile);
 } else {
-  opendir DIR, "$basedir" or die "$!";
-  @menufiles = grep { /.*?_$menufile$/ } readdir DIR;
-  closedir DIR;
-  unshift @menufiles, $menufile;
+  tie %dir_h, 'IO::Dir', $basedir;
+  @menufiles = map { "$basedir/$_" } grep { /.*?_$menufile$/ } keys %dir_h;
+  unshift @menufiles, "$basedir/$menufile";
 }
 
-opendir DIR, $dbupdir or die "$!";
-my @dbplfiles = grep { /\.pl$/ } readdir DIR;
-closedir DIR;
+tie %dir_h, 'IO::Dir', $dbupdir;
+my @dbplfiles = grep { /\.pl$/ } keys %dir_h;
 
-opendir DIR, $dbupdir2 or die "$!";
-my @dbplfiles2 = grep { /\.pl$/ } readdir DIR;
-closedir DIR;
+tie %dir_h, 'IO::Dir', $dbupdir2;
+my @dbplfiles2 = grep { /\.pl$/ } keys %dir_h;
 
 # slurp the translations in
-our $self    = {};
-our $missing = {};
-our @missing = ();
-our @lost    = ();
-
 if (-f "$locales_dir/all") {
   require "$locales_dir/all";
 }
@@ -85,11 +113,18 @@ if (-f "$locales_dir/lost") {
   unlink "$locales_dir/lost";
 }
 
+my $charset = slurp("$locales_dir/charset") || 'utf-8';
+chomp $charset;
+
 my %old_texts = %{ $self->{texts} || {} };
 
-map({ handle_file($_, $bindir); } @progfiles);
-map({ handle_file($_, $dbupdir); } @dbplfiles);
-map({ handle_file($_, $dbupdir2); } @dbplfiles2);
+handle_file(@{ $_ })       for @progfiles;
+handle_file($_, $dbupdir)  for @dbplfiles;
+handle_file($_, $dbupdir2) for @dbplfiles2;
+scanmenu($_)               for @menufiles;
+
+# merge entries to translate with entries from files 'missing' and 'lost'
+merge_texts();
 
 # generate all
 generate_file(
@@ -99,15 +134,24 @@ generate_file(
   data_sub  => sub { _print_line($_, $self->{texts}{$_}, @_) for sort keys %alllocales },
 );
 
+  foreach my $text (keys %$missing) {
+    if ($locale{$text} || $htmllocale{$text}) {
+      unless ($self->{texts}{$text}) {
+        $self->{texts}{$text} = $missing->{$text};
+      }
+    }
+  }
+
+
 # calc and generate missing
-push @missing, grep { !$self->{texts}{$_} } sort keys %alllocales;
+my @new_missing = grep { !$self->{texts}{$_} } sort keys %alllocales;
 
-if (@missing) {
+if (@new_missing) {
   generate_file(
     file      => "$locales_dir/missing",
     header    => $MISSING_HEADER,
     data_name => '$missing',
-    data_sub  => sub { _print_line($_, '', @_) for @missing },
+    data_sub  => sub { _print_line($_, '', @_) for @new_missing },
   );
 }
 
@@ -136,7 +180,7 @@ chomp $trlanguage;
 search_unused_htmlfiles() if $opt_c;
 
 my $count  = scalar keys %alllocales;
-my $notext = scalar @missing;
+my $notext = scalar @new_missing;
 my $per    = sprintf("%.1f", ($count - $notext) / $count * 100);
 print "\n$trlanguage - ${per}%";
 print " - $notext/$count missing" if $notext;
@@ -157,8 +201,8 @@ EOL
 # add the missing texts and run locales.pl to rebuild
 EOL
   $LOST_HEADER  = <<EOL;
-# The last 50 texts that have been removed.
-# This file will be auto-generated by locales.pl. Do not edit it.
+# The last 50 text strings, that have been removed.
+# This file has been auto-generated by locales.pl. Please don't edit!
 EOL
 }
 
@@ -222,29 +266,7 @@ sub handle_file {
     }
   }
 
-  # if this is the menu.pl file
-  if ($file eq 'menu.pl') {
-    foreach my $item (@menufiles) {
-      &scanmenu("$basedir/$item");
-    }
-  }
-
-  if ($file eq 'menunew.pl') {
-    foreach my $item (@menufiles) {
-      &scanmenu("$basedir/$item");
-      print "." if $opt_v;
-    }
-  }
-
   $file =~ s/\.pl//;
-
-  foreach my $text (keys %$missing) {
-    if ($locale{$text} || $htmllocale{$text}) {
-      unless ($self->{texts}{$text}) {
-        $self->{texts}{$text} = $missing->{$text};
-      }
-    }
-  }
 }
 
 sub extract_text_between_parenthesis {
@@ -279,11 +301,11 @@ sub extract_text_between_parenthesis {
 
     } else {
       if ($quote_next) {
+        $text .= '\\' unless $cur_char eq "'";
         $text .= $cur_char;
         $quote_next = 0;
 
       } elsif ($cur_char eq '\\') {
-        $text .= $cur_char;
         $quote_next = 1;
 
       } elsif ($cur_char eq $inside_string) {
@@ -320,6 +342,8 @@ sub scanfile {
     my ($is_submit, $line_no, $sub_line_no) = (0, 0, 0);
 
     while (<$fh>) {
+      last if /^\s*__END__/;
+
       $line_no++;
 
       # is this another file
@@ -335,16 +359,24 @@ sub scanfile {
       }
 
       # is this a template call?
-      if (/parse_html_template2?\s*\(\s*[\"\']([\w\/]+)\s*[\"\']/) {
-        my $newfile = "$basedir/templates/webpages/$1.html";
+      if (/(?:parse_html_template2?|render)\s*\(\s*[\"\']([\w\/]+)\s*[\"\']/) {
+        my $new_file_base = "$basedir/templates/webpages/$1.";
         if (/parse_html_template2/) {
-          print "E: " . strip_base($file) . " is still using 'parse_html_template2' for " . strip_base($newfile) . ".\n";
+          print "E: " . strip_base($file) . " is still using 'parse_html_template2' for " . strip_base("${new_file_base}html") . ".\n";
         }
-        if (-f $newfile) {
-           $cached{$file}{scanh}{$newfile} = 1;
-          print "." if $opt_v;
-        } elsif ($opt_c) {
-          print "W: missing HTML template: " . strip_base($newfile) . " (referenced from " . strip_base($file) . ")\n";
+
+        my $found_one = 0;
+        foreach my $ext (qw(html js json)) {
+          my $new_file = "${new_file_base}${ext}";
+          if (-f $new_file) {
+            $cached{$file}{scanh}{$new_file} = 1;
+            print "." if $opt_v;
+            $found_one = 1;
+          }
+        }
+
+        if ($opt_c && !$found_one) {
+          print "W: missing HTML template: " . strip_base($new_file_base) . "{html,json,js} (referenced from " . strip_base($file) . ")\n";
         }
       }
 
@@ -370,7 +402,7 @@ sub scanfile {
           }
         }
 
-        my ($found) = /locale->text.*?\(/;
+        my ($found) = / (?: locale->text | \b t8 ) \b .*? \(/x;
         $postmatch = "$'";
 
         if ($found) {
@@ -397,7 +429,7 @@ sub scanfile {
         }
 
         # exit loop if there are no more locales on this line
-        ($rc) = ($postmatch =~ /locale->text/);
+        ($rc) = ($postmatch =~ /locale->text | \b t8/x);
 
         if (   ($postmatch =~ />/)
             || (!$found && ($sub_line_no != $line_no) && />/)) {
@@ -410,14 +442,15 @@ sub scanfile {
 
   }
 
-  map { $alllocales{$_} = 1 }   keys %{$cached{$file}{all}};
-  map { $locale{$_} = 1 }       keys %{$cached{$file}{locale}};
-  map { $submit{$_} = 1 }       keys %{$cached{$file}{submit}};
-  map { &scanfile($_, 0, $scanned_files) } keys %{$cached{$file}{scan}};
-  map { &scanfile($_, 1, $scanned_files) } keys %{$cached{$file}{scannosubs}};
-  map { &scanhtmlfile($_)  }    keys %{$cached{$file}{scanh}};
+  $alllocales{$_} = 1             for keys %{$cached{$file}{all}};
+  $locale{$_}     = 1             for keys %{$cached{$file}{locale}};
+  $submit{$_}     = 1             for keys %{$cached{$file}{submit}};
+
+  scanfile($_, 0, $scanned_files) for keys %{$cached{$file}{scan}};
+  scanfile($_, 1, $scanned_files) for keys %{$cached{$file}{scannosubs}};
+  scanhtmlfile($_)                for keys %{$cached{$file}{scanh}};
 
-  @referenced_html_files{keys %{$cached{$file}{scanh}}} = (1) x scalar keys %{$cached{$file}{scanh}};
+  $referenced_html_files{$_} = 1  for keys %{$cached{$file}{scanh}};
 }
 
 sub scanmenu {
@@ -471,26 +504,26 @@ sub scanhtmlfile {
 
       while ($line =~ m/\[\%[^\w]*(\w+)\.\w+\(/g) {
         my $plugin = $1;
-        $plugins{needed}->{$plugin} = 1 if (first { $_ eq $plugin } qw(HTML LxERP JavaScript MultiColumnIterator));
+        $plugins{needed}->{$plugin} = 1 if (first { $_ eq $plugin } qw(HTML LxERP JavaScript MultiColumnIterator L));
       }
 
       while ($line =~ m/(?:             # Start von Variante 1: LxERP.t8('...'); ohne darumliegende [% ... %]-Tags
                           (LxERP\.t8)\( #   LxERP.t8(                             ::Parameter $1::
-                          ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $2::
-                          (.*?)         #   Der zu übersetzende String            ::Parameter $3::
-                          (?<!\\)\2     #   Ende des zu übersetzenden Strings
+                          ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $2::
+                          (.*?)         #   Der zu übersetzende String            ::Parameter $3::
+                          (?<!\\)\2     #   Ende des zu übersetzenden Strings
                         |               # Start von Variante 2: [% '...' | $T8 %]
                           \[\%          #   Template-Start-Tag
-                          [\-~#]?       #   Whitespace-Unterdrückung
+                          [\-~#]?       #   Whitespace-Unterdrückung
                           \s*           #   Optional beliebig viele Whitespace
-                          ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $4::
-                          (.*?)         #   Der zu übersetzende String            ::Parameter $5::
-                          (?<!\\)\4     #   Ende des zu übersetzenden Strings
+                          ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $4::
+                          (.*?)         #   Der zu übersetzende String            ::Parameter $5::
+                          (?<!\\)\4     #   Ende des zu übersetzenden Strings
                           \s*\|\s*      #   Pipe-Zeichen mit optionalen Whitespace davor und danach
                           (\$T8)        #   Filteraufruf                          ::Parameter $6::
-                          .*?           #   Optionale Argumente für den Filter
+                          .*?           #   Optionale Argumente für den Filter
                           \s*           #   Whitespaces
-                          [\-~#]?       #   Whitespace-Unterdrückung
+                          [\-~#]?       #   Whitespace-Unterdrückung
                           \%\]          #   Template-Ende-Tag
                         )
                        /ix) {
@@ -508,7 +541,7 @@ sub scanhtmlfile {
       }
 
       while ($line =~ m/\[\%          # Template-Start-Tag
-                        [\-~#]?       # Whitespace-Unterdrückung
+                        [\-~#]?       # Whitespace-Unterdrückung
                         \s*           # Optional beliebig viele Whitespace
                         (?:           # Die erkannten Template-Direktiven
                           PROCESS
@@ -535,13 +568,13 @@ sub scanhtmlfile {
   }
 
   # copy back into global arrays
-  map { $alllocales{$_} = 1 } keys %{$cached{$file}{all}};
-  map { $locale{$_} = 1 }     keys %{$cached{$file}{html}};
-  map { $submit{$_} = 1 }     keys %{$cached{$file}{submit}};
+  $alllocales{$_} = 1            for keys %{$cached{$file}{all}};
+  $locale{$_}     = 1            for keys %{$cached{$file}{html}};
+  $submit{$_}     = 1            for keys %{$cached{$file}{submit}};
 
-  map { scanhtmlfile($_)  }   keys %{$cached{$file}{scanh}};
+  scanhtmlfile($_)               for keys %{$cached{$file}{scanh}};
 
-  @referenced_html_files{keys %{$cached{$file}{scanh}}} = (1) x scalar keys %{$cached{$file}{scanh}};
+  $referenced_html_files{$_} = 1 for keys %{$cached{$file}{scanh}};
 }
 
 sub search_unused_htmlfiles {
@@ -573,7 +606,7 @@ sub strip_base {
 
 sub _single_quote {
   my $val = shift;
-  $val =~ s/('|\\$)/\\$1/g;
+  $val =~ s/(\'|\\$)/\\$1/g;
   return  "'" . $val .  "'";
 }
 
@@ -596,9 +629,12 @@ sub generate_file {
   my $data_name = $params{data_name};
   my @delim     = split //, ($params{delim} || '{}');
 
-  open my $fh, '>', $file or die "$! : $file";
+  open my $fh, '>:encoding(utf8)', $file or die "$! : $file";
+
+  $charset =~ s/\r?\n//g;
+  my $emacs_charset = lc $charset;
 
-  print $fh "#!/usr/bin/perl\n\n";
+  print $fh "#!/usr/bin/perl\n# -*- coding: $emacs_charset; -*-\n# vim: fenc=$charset\n\nuse utf8;\n\n";
   print $fh $header, "\n" if $header;
   print $fh "$data_name = $delim[0]\n" if $data_name;
 
@@ -608,15 +644,20 @@ sub generate_file {
   close $fh;
 }
 
+sub slurp {
+  my $file = shift;
+  do { local ( @ARGV, $/ ) = $file; <> }
+}
+
 __END__
 
 =head1 NAME
 
-locales.pl - Collect strings for translation in Lx-Office
+locales.pl - Collect strings for translation in kivitendo
 
 =head1 SYNOPSIS
 
-locales.pl [options]
+locales.pl [options] lang_code
 
  Options:
   -n, --no-custom-files  Do not process files whose name contains "_"
@@ -647,7 +688,6 @@ Be more verbose.
 =head1 DESCRIPTION
 
 This script collects strings from Perl files, the menu.ini file and
-HTML templates and puts them into the file "all" for translation.  It
-also distributes those translations back to the individual files.
+HTML templates and puts them into the file "all" for translation.
 
 =cut