X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=misc%2Ftranslator%2Ftmpl_process3.pl;h=4ded16fb7c72077c08a4e0daedf4342e25b0f554;hb=9111db96fab0c0bd87e5652129efd0ae10c16784;hp=993e2a8ce8732c559059e19854f85c1b32ca8263;hpb=d5f51e8d8d2bac8d1455b3efa88cf8e223499fea;p=koha.git diff --git a/misc/translator/tmpl_process3.pl b/misc/translator/tmpl_process3.pl index 993e2a8ce8..4ded16fb7c 100755 --- a/misc/translator/tmpl_process3.pl +++ b/misc/translator/tmpl_process3.pl @@ -13,6 +13,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 +22,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 +64,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) { @@ -131,25 +132,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 +172,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 +190,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 +229,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 +253,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 +366,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 +389,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 +435,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 +551,13 @@ Anchors are represented by an > 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.