# 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
=cut
use strict;
+#use warnings; FIXME - Bug 2505
+use File::Basename;
use Getopt::Long;
use Locale::PO;
use File::Temp qw( :POSIX );
###############################################################################
-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 );
my($s) = @_;
my $key = $s;
if ($s =~ /\S/s) {
- $key = TmplTokenizer::string_canon($key);
- $key = TmplTokenizer::charset_convert($key, $charset_in, $charset_out);
- $key = TmplTokenizer::quote_po($key);
+ $key = TmplTokenizer::string_canon($key);
+ $key = TmplTokenizer::charset_convert($key, $charset_in, $charset_out);
+ $key = TmplTokenizer::quote_po($key);
+ }
+ if (defined $href->{$key} && !$href->{$key}->fuzzy && length Locale::PO->dequote($href->{$key}->msgstr)){
+ if ($s =~ /^(\s+)/){
+ return $1 . Locale::PO->dequote($href->{$key}->msgstr);
+ }
+ else {
+ return Locale::PO->dequote($href->{$key}->msgstr);
+ }
+ }
+ else {
+ return $s;
}
- return defined $href->{$key}
- && !$href->{$key}->fuzzy
- && length Locale::PO->dequote($href->{$key}->msgstr)?
- Locale::PO->dequote($href->{$key}->msgstr): $s;
}
sub text_replace_tag ($$) {
my($t, $attr) = @_;
my $it;
+
# value [tag=input], meta
my $tag = lc($1) if $t =~ /^<(\S+)/s;
my $translated_p = 0;
- for my $a ('alt', 'content', 'title', 'value') {
+ for my $a ('alt', 'content', 'title', 'value', 'label', 'placeholder') {
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] =~ /^(?: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) {
my $s = find_translation($val);
}
}
if ($translated_p) {
- $it = "<$tag"
- . join('', map {
- sprintf(' %s=%s', $_, $attr->{$_}->[2]) #FIXME
- } sort {
- $attr->{$a}->[3] <=> $attr->{$b}->[3] #FIXME
- } keys %$attr)
- . '>';
- } else {
- $it = $t;
+ $it = "<$tag"
+ . join('', map { if ($_ ne '/'){
+ sprintf(' %s="%s"', $_, $attr->{$_}->[1]);
+ }
+ else {
+ sprintf(' %s',$_);
+ }
+
+ } sort {
+ $attr->{$a}->[3] <=> $attr->{$b}->[3] #FIXME
+ || $a cmp $b # Sort attributes BZ 22236
+ } keys %$attr);
+ $it .= '>';
+ }
+ else {
+ $it = $t;
}
return $it;
}
my $s = TmplTokenizer::next_token $h;
last unless defined $s;
my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
- if ($kind eq TmplTokenType::TEXT) {
+ if ($kind eq C4::TmplTokenType::TEXT) {
print $output find_translation($t);
- } elsif ($kind eq TmplTokenType::TEXT_PARAMETRIZED) {
+ } elsif ($kind eq C4::TmplTokenType::TEXT_PARAMETRIZED) {
my $fmt = find_translation($s->form);
print $output TmplTokenizer::parametrize($fmt, 1, $s, sub {
$_ = $_[0];
my($kind, $t, $attr) = ($_->type, $_->string, $_->attributes);
- $kind == TmplTokenType::TAG && %$attr?
+ $kind == C4::TmplTokenType::TAG && %$attr?
text_replace_tag($t, $attr): $t });
- } elsif ($kind eq TmplTokenType::TAG && %$attr) {
+ } elsif ($kind eq C4::TmplTokenType::TAG && %$attr) {
print $output text_replace_tag($t, $attr);
} elsif ($s->has_js_data) {
for my $t (@{$s->js_data}) {
}
}
} elsif (defined $t) {
+ # Quick fix to bug 4472
+ $t = "<!DOCTYPE stylesheet [" if $t =~ /DOCTYPE stylesheet/ ;
print $output $t;
}
}
}
-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;
}
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;
}
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);
-}#`
+}
###############################################################################
###############################################################################
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,
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 *.tmpl plus *.inc if not specified
-$type = "tmpl|inc" if !defined($type);
+# Type match defaults to *.tt plus *.inc if not specified
+$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
die "$str_file: PO file is corrupted, or not a PO file\n" unless defined $href->{'""'};
$charset_out = TmplTokenizer::charset_canon $2 if $href->{'""'}->msgstr =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/;
$charset_in = $charset_out;
- warn "Charset in/out: ".$charset_out;
# for my $msgid (keys %$href) {
# if ($msgid =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/) {
# my $candidate = TmplTokenizer::charset_canon $2;
# $charset_in = $candidate;
# }
# }
+
+ # BUG6464: check consistency of PO messages
+ # - count number of '%s' in msgid and msgstr
+ for my $msg ( values %$href ) {
+ my $id_count = split(/%s/, $msg->{msgid}) - 1;
+ my $str_count = split(/%s/, $msg->{msgstr}) - 1;
+ next if $id_count == $str_count ||
+ $msg->{msgstr} eq '""' ||
+ grep { /fuzzy/ } @{$msg->{_flags}};
+ warn_normal
+ "unconsistent %s count: ($id_count/$str_count):\n" .
+ " line: " . $msg->{loaded_line_number} . "\n" .
+ " msgid: " . $msg->{msgid} . "\n" .
+ " msgstr: " . $msg->{msgstr} . "\n", undef;
+ }
}
# set our charset in to UTF-8
close INPUT;
close OUTPUT;
}
- $st = system('msgmerge', '-U', '-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();
(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', '-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;
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";
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;
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.
projects / koha.git / blobdiff