removed C4::Dates from koha-ffzg.psgi
[koha.git] / misc / translator / tmpl_process3.pl
index 993e2a8..6f4c39e 100755 (executable)
@@ -4,6 +4,9 @@
 # Parts copyright 2003-2004 Jerome Vizcaino
 # Parts copyright 2004 Ambrose Li
 
+use FindBin;
+use lib $FindBin::Bin;
+
 =head1 NAME
 
 tmpl_process3.pl - Alternative version of tmpl_process.pl
@@ -13,6 +16,7 @@ using gettext-compatible translation files
 
 use strict;
 #use warnings; FIXME - Bug 2505
+use File::Basename;
 use Getopt::Long;
 use Locale::PO;
 use File::Temp qw( :POSIX );
@@ -21,7 +25,7 @@ use VerboseWarnings qw( :warn :die );
 
 ###############################################################################
 
-use vars qw( @in_files $in_dir $str_file $out_dir $quiet );
+use vars qw( @in_dirs @filenames @match @nomatch $str_file $out_dir $quiet );
 use vars qw( @excludes $exclude_regex );
 use vars qw( $recursive_p );
 use vars qw( $pedantic_p );
@@ -63,7 +67,7 @@ sub text_replace_tag ($$) {
     if ($attr->{$a}) {
         next if $a eq 'label' && $tag ne 'optgroup';
         next if $a eq 'content' && $tag ne 'meta';
-        next if $a eq 'value' && ($tag ne 'input' || (ref $attr->{'type'} && $attr->{'type'}->[1] =~ /^(?:checkbox|hidden|radio|text)$/)); # FIXME
+        next if $a eq 'value' && ($tag ne 'input' || (ref $attr->{'type'} && $attr->{'type'}->[1] =~ /^(?:checkbox|hidden|radio)$/)); # FIXME
 
         my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
         if ($val =~ /\S/s) {
@@ -87,6 +91,7 @@ sub text_replace_tag ($$) {
                          
               } sort {
                   $attr->{$a}->[3] <=> $attr->{$b}->[3] #FIXME
+                      || $a cmp $b # Sort attributes BZ 22236
               } keys %$attr);
         $it .= '>';
     }
@@ -131,25 +136,33 @@ sub text_replace (**) {
     }
 }
 
-sub listfiles ($$$) {
+sub listfiles {
     my($dir, $type, $action) = @_;
+    my $filenames = join ('|', @filenames); # used to update strings from this file
+    my $match     = join ('|', @match);     # use only this files
+    my $nomatch   = join ('|', @nomatch);   # do no use this files
     my @it = ();
     if (opendir(DIR, $dir)) {
-    my @dirent = readdir DIR;   # because DIR is shared when recursing
-    closedir DIR;
-    for my $dirent (@dirent) {
-        my $path = "$dir/$dirent";
-        if ($dirent =~ /^\./ || $dirent eq 'CVS' || $dirent eq 'RCS'
-        || (defined $exclude_regex && $dirent =~ /^(?:$exclude_regex)$/)) {
-        ;
-        } elsif (-f $path) {
-        push @it, $path if (!defined $type || $dirent =~ /\.(?:$type)$/) || $action eq 'install';
-        } elsif (-d $path && $recursive_p) {
-        push @it, listfiles($path, $type, $action);
+        my @dirent = readdir DIR;   # because DIR is shared when recursing
+        closedir DIR;
+        for my $dirent (@dirent) {
+            my $path = "$dir/$dirent";
+            if ($dirent =~ /^\./ || $dirent eq 'CVS' || $dirent eq 'RCS'
+            || (defined $exclude_regex && $dirent =~ /^(?:$exclude_regex)$/)) {
+            ;
+            } elsif (-f $path) {
+                my $basename = fileparse( $path );
+                push @it, $path
+                    if  ( not @filenames or $basename =~ /($filenames)/i )
+                    and ( not @match     or $basename =~ /($match)/i     ) # files to include
+                    and ( not @nomatch   or $basename !~ /($nomatch)/i   ) # files not to include
+                    and (!defined $type || $dirent =~ /\.(?:$type)$/) || $action eq 'install';
+            } elsif (-d $path && $recursive_p) {
+                push @it, listfiles($path, $type, $action);
+            }
         }
-    }
     } else {
-    warn_normal "$dir: $!", undef;
+        warn_normal "$dir: $!", undef;
     }
     return @it;
 }
@@ -163,7 +176,7 @@ sub mkdir_recursive ($) {
     my ($prefix, $basename) = ($dir =~ /\/([^\/]+)$/s)? ($`, $1): ('.', $dir);
     mkdir_recursive($prefix) if $prefix ne '.' && !-d $prefix;
     if (!-d $dir) {
-    print STDERR "Making directory $dir..." unless $quiet;
+    print STDERR "Making directory $dir...\n" unless $quiet;
     # creates with rwxrwxr-x permissions
     mkdir($dir, 0775) || warn_normal "$dir: $!", undef;
     }
@@ -181,23 +194,31 @@ Usage: $0 create [OPTION]
   or:  $0 --help
 Create or update PO files from templates, or install translated templates.
 
-  -i, --input=SOURCE          Get or update strings from SOURCE file.
-                              SOURCE is a directory if -r is also specified.
+  -i, --input=SOURCE          Get or update strings from SOURCE directory(s).
+                              On create or update can have multiple values.
+                              On install only one value.
   -o, --outputdir=DIRECTORY   Install translation(s) to specified DIRECTORY
       --pedantic-warnings     Issue warnings even for detected problems
                               which are likely to be harmless
   -r, --recursive             SOURCE in the -i option is a directory
+  -f, --filename=FILE         FILE is a specific filename or part of it.
+                              If given, only these files will be processed.
+                              On update only relevant strings will be updated.
+  -m, --match=FILE            FILE is a specific filename or part of it.
+                              If given, only these files will be processed.
+  -n, --nomatch=FILE          FILE is a specific filename or part of it.
+                              If given, these files will not be processed.
   -s, --str-file=FILE         Specify FILE as the translation (po) file
                               for input (install) or output (create, update)
-  -x, --exclude=REGEXP        Exclude files matching the given REGEXP
+  -x, --exclude=REGEXP        Exclude dirs matching the given REGEXP
       --help                  Display this help and exit
   -q, --quiet                 no output to screen (except for errors)
 
 The -o option is ignored for the "create" and "update" actions.
-Try `perldoc $0 for perhaps more information.
+Try `perldoc $0` for perhaps more information.
 EOF
     exit($exitcode);
-}#`
+}
 
 ###############################################################################
 
@@ -212,7 +233,10 @@ sub usage_error (;$) {
 ###############################################################################
 
 GetOptions(
-    'input|i=s'             => \@in_files,
+    'input|i=s'             => \@in_dirs,
+    'filename|f=s'          => \@filenames,
+    'match|m=s'             => \@match,
+    'nomatch|n=s'           => \@nomatch,
     'outputdir|o=s'         => \$out_dir,
     'recursive|r'           => \$recursive_p,
     'str-file|s=s'          => \$str_file,
@@ -233,35 +257,32 @@ $SIG{__WARN__} = sub {
 
 my $action = shift or usage_error('You must specify an ACTION.');
 usage_error('You must at least specify input and string list filenames.')
-    if !@in_files || !defined $str_file;
+    if !@in_dirs || !defined $str_file;
 
 # Type match defaults to *.tt plus *.inc if not specified
-$type = "tt|inc|xsl|xml" if !defined($type);
+$type = "tt|inc|xsl|xml|def" if !defined($type);
 
-# Check the inputs for being files or directories
-for my $input (@in_files) {
-    usage_error("$input: Input must be a file or directory.\n"
+# Check the inputs for being directories
+for my $in_dir ( @in_dirs ) {
+    usage_error("$in_dir: Input must be a directory.\n"
         . "(Symbolic links are not supported at the moment)")
-    unless -d $input || -f $input;;
+        unless -d $in_dir;
 }
 
 # Generates the global exclude regular expression
 $exclude_regex =  '(?:'.join('|', @excludes).')' if @excludes;
 
+my @in_files;
 # Generate the list of input files if a directory is specified
-if (-d $in_files[0]) {
-    die "If you specify a directory as input, you must specify only it.\n"
-        if @in_files > 1;
+# input is a directory, generates list of files to process
 
-    # input is a directory, generates list of files to process
-    $in_dir = $in_files[0];
-    $in_dir =~ s/\/$//; # strips the trailing / if any
-    @in_files = listfiles($in_dir, $type, $action);
-} else {
-    for my $input (@in_files) {
+for my $fn ( @filenames ) {
     die "You cannot specify input files and directories at the same time.\n"
-        unless -f $input;
-    }
+        if -d $fn;
+}
+for my $in_dir ( @in_dirs ) {
+    $in_dir =~ s/\/$//; # strips the trailing / if any
+    @in_files = ( @in_files, listfiles($in_dir, $type, $action));
 }
 
 # restores the string list from file
@@ -349,13 +370,13 @@ if ($action eq 'create')  {
         close INPUT;
         close OUTPUT;
     }
-    $st = system("msgmerge -U ".($quiet?'-q':'')." -s $str_file $tmpfile2");
+    $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file");
     } else {
     error_normal "Text extraction failed: $xgettext: $!\n", undef;
     error_additional "Will not run msgmerge\n", undef;
     }
-#   unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef;
-#   unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef;
+    unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef;
+    unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef;
 
 } elsif ($action eq 'update') {
     my($tmph1, $tmpfile1) = tmpnam();
@@ -372,22 +393,35 @@ if ($action eq 'create')  {
         (defined $charset_in? ('-I', $charset_in): ()),
         (defined $charset_out? ('-O', $charset_out): ()));
     if ($st == 0) {
-    # Merge the temporary "pot file" with the specified po file ($str_file)
-    # FIXME: msgmerge(1) is a Unix dependency
-    # FIXME: need to check the return value
-    $st = system("msgmerge -U ".($quiet?'-q':'')." -s $str_file $tmpfile2");
+        # Merge the temporary "pot file" with the specified po file ($str_file)
+        # FIXME: msgmerge(1) is a Unix dependency
+        # FIXME: need to check the return value
+        if ( @filenames ) {
+            my ($tmph3, $tmpfile3) = tmpnam();
+            $st = system("msgcat $str_file $tmpfile2 > $tmpfile3");
+            $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile3 -o - | msgattrib --no-obsolete -o $str_file")
+                unless $st;
+        } else {
+            $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file");
+        }
     } else {
-    error_normal "Text extraction failed: $xgettext: $!\n", undef;
-    error_additional "Will not run msgmerge\n", undef;
+        error_normal "Text extraction failed: $xgettext: $!\n", undef;
+        error_additional "Will not run msgmerge\n", undef;
     }
-#   unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef;
-#   unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef;
+    unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef;
+    unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef;
 
 } elsif ($action eq 'install') {
     if(!defined($out_dir)) {
     usage_error("You must specify an output directory when using the install method.");
     }
     
+    if ( scalar @in_dirs > 1 ) {
+    usage_error("You must specify only one input directory when using the install method.");
+    }
+
+    my $in_dir = shift @in_dirs;
+
     if ($in_dir eq $out_dir) {
     warn "You must specify a different input and output directory.\n";
     exit -1;
@@ -405,23 +439,21 @@ if ($action eq 'create')  {
     for my $input (@in_files) {
         die "Assertion failed"
             unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/";
-#       print "$input / $type\n";
+
+        my $target = $out_dir . substr($input, length($in_dir));
+        my $targetdir = $` if $target =~ /[^\/]+$/s;
+
         if (!defined $type || $input =~ /\.(?:$type)$/) {
             my $h = TmplTokenizer->new( $input );
             $h->set_allow_cformat( 1 );
             VerboseWarnings::set_input_file_name $input;
-        
-            my $target = $out_dir . substr($input, length($in_dir));
-            my $targetdir = $` if $target =~ /[^\/]+$/s;
             mkdir_recursive($targetdir) unless -d $targetdir;
             print STDERR "Creating $target...\n" unless $quiet;
-            open( OUTPUT, ">$target" ) || die "$target: $!\n";            
+            open( OUTPUT, ">$target" ) || die "$target: $!\n";
             text_replace( $h, *OUTPUT );
             close OUTPUT;
         } else {
         # just copying the file
-            my $target = $out_dir . substr($input, length($in_dir));
-            my $targetdir = $` if $target =~ /[^\/]+$/s;
             mkdir_recursive($targetdir) unless -d $targetdir;
             system("cp -f $input $target");
             print STDERR "Copying $input...\n" unless $quiet;
@@ -523,13 +555,13 @@ Anchors are represented by an <AI<n>> notation.
 The meaning of this non-standard notation might not be obvious.
 
 The create action calls xgettext.pl to do the actual work;
-the update action calls xgettext.pl and msgmerge(1) to do the
-actual work.
+the update action calls xgettext.pl, msgmerge(1) and msgattrib(1)
+to do the actual work.
 
 =head1 BUGS
 
-xgettext.pl must be present in the current directory; the
-msgmerge(1) command must also be present in the search path.
+xgettext.pl must be present in the current directory; both
+msgmerge(1) and msgattrib(1) must also be present in the search path.
 The script currently does not check carefully whether these
 dependent commands are present.