use vars qw( $recursive_p );
use vars qw( $pedantic_p );
use vars qw( $href );
-use vars qw( $type ); # file extension (DOS form without the dot) to match
+use vars qw( $type ); # file extension (DOS form without the dot) to match
use vars qw( $charset_in $charset_out );
###############################################################################
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);
}
return defined $href->{$key}
- && !$href->{$key}->fuzzy
- && length Locale::PO->dequote($href->{$key}->msgstr)?
- Locale::PO->dequote($href->{$key}->msgstr): $s;
+ && !$href->{$key}->fuzzy
+ && length Locale::PO->dequote($href->{$key}->msgstr)?
+ Locale::PO->dequote($href->{$key}->msgstr): $s;
}
sub text_replace_tag ($$) {
my $tag = lc($1) if $t =~ /^<(\S+)/s;
my $translated_p = 0;
for my $a ('alt', 'content', 'title', 'value') {
- if ($attr->{$a}) {
- 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
- my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
- if ($val =~ /\S/s) {
- my $s = find_translation($val);
- if ($attr->{$a}->[1] ne $s) { #FIXME
- $attr->{$a}->[1] = $s; # FIXME
- $attr->{$a}->[2] = ($s =~ /"/s)? "'$s'": "\"$s\""; #FIXME
- $translated_p = 1;
- }
- }
- }
+ if ($attr->{$a}) {
+ 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|submit)$/)); # FIXME
+ my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
+ if ($val =~ /\S/s) {
+ my $s = find_translation($val);
+ if ($attr->{$a}->[1] ne $s) { #FIXME
+ $attr->{$a}->[1] = $s; # FIXME
+ $attr->{$a}->[2] = ($s =~ /"/s)? "'$s'": "\"$s\""; #FIXME
+ $translated_p = 1;
+ }
+ }
+ }
}
if ($translated_p) {
- $it = "<$tag"
- . join('', map {
- sprintf(' %s=%s', $_, $attr->{$_}->[2]) #FIXME
- } sort {
- $attr->{$a}->[3] <=> $attr->{$b}->[3] #FIXME
- } keys %$attr)
- . '>';
+ $it = "<$tag"
+ . join('', map {
+ sprintf(' %s=%s', $_, $attr->{$_}->[2]) #FIXME
+ } sort {
+ $attr->{$a}->[3] <=> $attr->{$b}->[3] #FIXME
+ } keys %$attr)
+ . '>';
} else {
- $it = $t;
+ $it = $t;
}
return $it;
}
sub text_replace (**) {
my($h, $output) = @_;
for (;;) {
- my $s = TmplTokenizer::next_token $h;
+ 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) {
- print $output find_translation($t);
- } elsif ($kind eq 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?
- text_replace_tag($t, $attr): $t });
- } elsif ($kind eq TmplTokenType::TAG && %$attr) {
- print $output text_replace_tag($t, $attr);
- } elsif ($s->has_js_data) {
- for my $t (@{$s->js_data}) {
- # FIXME for this whole block
- if ($t->[0]) {
- printf $output "%s%s%s", $t->[2], find_translation $t->[3],
- $t->[2];
- } else {
- print $output $t->[1];
- }
- }
- } elsif (defined $t) {
- print $output $t;
- }
+ my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
+ if ($kind eq TmplTokenType::TEXT) {
+ print $output find_translation($t);
+ } elsif ($kind eq 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?
+ text_replace_tag($t, $attr): $t });
+ } elsif ($kind eq TmplTokenType::TAG && %$attr) {
+ print $output text_replace_tag($t, $attr);
+ } elsif ($s->has_js_data) {
+ for my $t (@{$s->js_data}) {
+ # FIXME for this whole block
+ if ($t->[0]) {
+ printf $output "%s%s%s", $t->[2], find_translation $t->[3],
+ $t->[2];
+ } else {
+ print $output $t->[1];
+ }
+ }
+ } elsif (defined $t) {
+ print $output $t;
+ }
}
}
my($dir, $type, $action) = @_;
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) {
+ push @it, $path if (!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;
- # creates with rwxrwxr-x permissions
- mkdir($dir, 0775) || warn_normal "$dir: $!", undef;
+ print STDERR "Making directory $dir..." unless $quiet;
+ # creates with rwxrwxr-x permissions
+ mkdir($dir, 0775) || warn_normal "$dir: $!", undef;
}
}
sub usage_error (;$) {
for my $msg (split(/\n/, $_[0])) {
- print STDERR "$msg\n";
+ print STDERR "$msg\n";
}
print STDERR "Try `$0 --help for more information.\n";
exit(-1);
###############################################################################
GetOptions(
- 'input|i=s' => \@in_files,
- 'outputdir|o=s' => \$out_dir,
- 'recursive|r' => \$recursive_p,
- 'str-file|s=s' => \$str_file,
- 'exclude|x=s' => \@excludes,
- 'quiet|q' => \$quiet,
- 'pedantic-warnings|pedantic' => sub { $pedantic_p = 1 },
- 'help' => \&usage,
+ 'input|i=s' => \@in_files,
+ 'outputdir|o=s' => \$out_dir,
+ 'recursive|r' => \$recursive_p,
+ 'str-file|s=s' => \$str_file,
+ 'exclude|x=s' => \@excludes,
+ 'quiet|q' => \$quiet,
+ 'pedantic-warnings|pedantic' => sub { $pedantic_p = 1 },
+ 'help' => \&usage,
) || usage_error;
VerboseWarnings::set_application_name $0;
# keep the buggy Locale::PO quiet if it says stupid things
$SIG{__WARN__} = sub {
- my($s) = @_;
- print STDERR $s unless $s =~ /^Strange line in [^:]+: #~/s
+ my($s) = @_;
+ print STDERR $s unless $s =~ /^Strange line in [^:]+: #~/s
};
my $action = shift or usage_error('You must specify an ACTION.');
if !@in_files || !defined $str_file;
# Type match defaults to *.tmpl plus *.inc if not specified
-$type = "tmpl|inc" if !defined($type);
+$type = "tmpl|inc|js|xsl|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"
- . "(Symbolic links are not supported at the moment)")
- unless -d $input || -f $input;;
+ . "(Symbolic links are not supported at the moment)")
+ unless -d $input || -f $input;;
}
# Generates the global exclude regular expression
# 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;
+ if @in_files > 1;
# input is a directory, generates list of files to process
$in_dir = $in_files[0];
@in_files = listfiles($in_dir, $type, $action);
} else {
for my $input (@in_files) {
- die "You cannot specify input files and directories at the same time.\n"
- unless -f $input;
+ die "You cannot specify input files and directories at the same time.\n"
+ unless -f $input;
}
}
# guess the charsets. HTML::Templates defaults to iso-8859-1
if (defined $href) {
- 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/;
- for my $msgid (keys %$href) {
- if ($msgid =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/) {
- my $candidate = TmplTokenizer::charset_canon $2;
- die "Conflicting charsets in msgid: $charset_in vs $candidate\n"
- if defined $charset_in && $charset_in ne $candidate;
- $charset_in = $candidate;
- }
- }
+ 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;
+# die "Conflicting charsets in msgid: $charset_in vs $candidate => $msgid\n"
+# if defined $charset_in && $charset_in ne $candidate;
+# $charset_in = $candidate;
+# }
+# }
}
+
+# set our charset in to UTF-8
if (!defined $charset_in) {
- $charset_in = TmplTokenizer::charset_canon 'iso8859-1';
+ $charset_in = TmplTokenizer::charset_canon 'UTF-8';
warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n";
}
-
-my $xgettext = './xgettext.pl'; # actual text extractor script
+# set our charset out to UTF-8
+if (!defined $charset_out) {
+ $charset_out = TmplTokenizer::charset_canon 'UTF-8';
+ warn "Warning: Charset Out defaulting to $charset_out\n";
+}
+my $xgettext = './xgettext.pl'; # actual text extractor script
my $st;
if ($action eq 'create') {
# updates the list. As the list is empty, every entry will be added
if (!-s $str_file) {
- warn "Removing empty file $str_file\n";
- unlink $str_file || die "$str_file: $!\n";
+ warn "Removing empty file $str_file\n";
+ unlink $str_file || die "$str_file: $!\n";
}
die "$str_file: Output file already exists\n" if -f $str_file;
my($tmph1, $tmpfile1) = tmpnam();
close $tmph2; # We just want a name
# Generate the temporary file that acts as <MODULE>/POTFILES.in
for my $input (@in_files) {
- print $tmph1 "$input\n";
+ print $tmph1 "$input\n";
}
close $tmph1;
+ warn "I $charset_in O $charset_out";
# Generate the specified po file ($str_file)
- $st = system ($xgettext, '-s', '-f', $tmpfile1, '-o', $tmpfile2);
+ $st = system ($xgettext, '-s', '-f', $tmpfile1, '-o', $tmpfile2,
+ (defined $charset_in? ('-I', $charset_in): ()),
+ (defined $charset_out? ('-O', $charset_out): ())
+ );
# Run msgmerge so that the pot file looks like a real pot file
# We need to help msgmerge a bit by pre-creating a dummy po file that has
# the headers and the "" msgid & msgstr. It will fill in the rest.
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
- unless (-f $str_file) {
- local(*INPUT, *OUTPUT);
- open(INPUT, "<$tmpfile2");
- open(OUTPUT, ">$str_file");
- while (<INPUT>) {
- print OUTPUT;
- last if /^\n/s;
- }
- close INPUT;
- close OUTPUT;
- }
- $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
+ unless (-f $str_file) {
+ local(*INPUT, *OUTPUT);
+ open(INPUT, "<$tmpfile2");
+ open(OUTPUT, ">$str_file");
+ while (<INPUT>) {
+ print OUTPUT;
+ last if /^\n/s;
+ }
+ close INPUT;
+ close OUTPUT;
+ }
+ $st = system('msgmerge', '-U', '-s', $str_file, $tmpfile2);
} 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;
close $tmph2; # We just want a name
# Generate the temporary file that acts as <MODULE>/POTFILES.in
for my $input (@in_files) {
- print $tmph1 "$input\n";
+ print $tmph1 "$input\n";
}
close $tmph1;
# Generate the temporary file that acts as <MODULE>/<LANG>.pot
$st = system($xgettext, '-s', '-f', $tmpfile1, '-o', $tmpfile2,
- '--po-mode',
- (defined $charset_in? ('-I', $charset_in): ()),
- (defined $charset_out? ('-O', $charset_out): ()));
+ '--po-mode',
+ (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
+ $st = system('msgmerge', '-U', '-s', $str_file, $tmpfile2);
} 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;
} elsif ($action eq 'install') {
if(!defined($out_dir)) {
- usage_error("You must specify an output directory when using the install method.");
+ usage_error("You must specify an output directory when using the install method.");
}
-
+
if ($in_dir eq $out_dir) {
- warn "You must specify a different input and output directory.\n";
- exit -1;
+ warn "You must specify a different input and output directory.\n";
+ exit -1;
}
# Make sure the output directory exists
# creates the new tmpl file using the new translation
for my $input (@in_files) {
- die "Assertion failed"
- unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/";
-# print "$input / $type\n";
- 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";
- 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;
- }
- }
+ die "Assertion failed"
+ unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/";
+# print "$input / $type\n";
+ 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";
+ 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;
+ }
+ }
} else {
usage_error('Unknown action specified.');
projects / koha.git / blobdiff