|
Lines 35-41
use vars qw( $charset_in $charset_out );
Link Here
|
| 35 |
|
35 |
|
| 36 |
############################################################################### |
36 |
############################################################################### |
| 37 |
|
37 |
|
| 38 |
sub find_translation ($) { |
38 |
sub find_translation { |
| 39 |
my($s) = @_; |
39 |
my($s) = @_; |
| 40 |
my $key = $s; |
40 |
my $key = $s; |
| 41 |
if ($s =~ /\S/s) { |
41 |
if ($s =~ /\S/s) { |
|
Lines 56-68
sub find_translation ($) {
Link Here
|
| 56 |
} |
56 |
} |
| 57 |
} |
57 |
} |
| 58 |
|
58 |
|
| 59 |
sub text_replace_tag ($$) { |
59 |
sub text_replace_tag { |
| 60 |
my($t, $attr) = @_; |
60 |
my($t, $attr) = @_; |
| 61 |
my $it; |
61 |
my $it; |
| 62 |
my @ttvar; |
62 |
my @ttvar; |
| 63 |
|
63 |
|
| 64 |
# value [tag=input], meta |
64 |
# value [tag=input], meta |
| 65 |
my $tag = lc($1) if $t =~ /^<(\S+)/s; |
65 |
my $tag = ($t =~ /^<(\S+)/s) ? lc($1) : undef; |
| 66 |
my $translated_p = 0; |
66 |
my $translated_p = 0; |
| 67 |
for my $a ('alt', 'content', 'title', 'value', 'label', 'placeholder') { |
67 |
for my $a ('alt', 'content', 'title', 'value', 'label', 'placeholder') { |
| 68 |
if ($attr->{$a}) { |
68 |
if ($attr->{$a}) { |
|
Lines 117-126
sub text_replace_tag ($$) {
Link Here
|
| 117 |
return $it; |
117 |
return $it; |
| 118 |
} |
118 |
} |
| 119 |
|
119 |
|
| 120 |
sub text_replace (**) { |
120 |
sub text_replace { |
| 121 |
my($h, $output) = @_; |
121 |
my($h, $output) = @_; |
| 122 |
for (;;) { |
122 |
for (;;) { |
| 123 |
my $s = TmplTokenizer::next_token $h; |
123 |
my $s = TmplTokenizer::next_token($h); |
| 124 |
last unless defined $s; |
124 |
last unless defined $s; |
| 125 |
my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes); |
125 |
my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes); |
| 126 |
if ($kind eq C4::TmplTokenType::TEXT) { |
126 |
if ($kind eq C4::TmplTokenType::TEXT) { |
|
Lines 138-144
sub text_replace (**) {
Link Here
|
| 138 |
for my $t (@{$s->js_data}) { |
138 |
for my $t (@{$s->js_data}) { |
| 139 |
# FIXME for this whole block |
139 |
# FIXME for this whole block |
| 140 |
if ($t->[0]) { |
140 |
if ($t->[0]) { |
| 141 |
printf $output "%s%s%s", $t->[2], find_translation $t->[3], |
141 |
printf $output "%s%s%s", $t->[2], find_translation($t->[3]), |
| 142 |
$t->[2]; |
142 |
$t->[2]; |
| 143 |
} else { |
143 |
} else { |
| 144 |
print $output $t->[1]; |
144 |
print $output $t->[1]; |
|
Lines 178-191
sub listfiles {
Link Here
|
| 178 |
} |
178 |
} |
| 179 |
} |
179 |
} |
| 180 |
} else { |
180 |
} else { |
| 181 |
warn_normal "$dir: $!", undef; |
181 |
warn_normal("$dir: $!", undef); |
| 182 |
} |
182 |
} |
| 183 |
return @it; |
183 |
return @it; |
| 184 |
} |
184 |
} |
| 185 |
|
185 |
|
| 186 |
############################################################################### |
186 |
############################################################################### |
| 187 |
|
187 |
|
| 188 |
sub mkdir_recursive ($) { |
188 |
sub mkdir_recursive { |
| 189 |
my($dir) = @_; |
189 |
my($dir) = @_; |
| 190 |
local($`, $&, $', $1); |
190 |
local($`, $&, $', $1); |
| 191 |
$dir = $` if $dir ne /^\/+$/ && $dir =~ /\/+$/; |
191 |
$dir = $` if $dir ne /^\/+$/ && $dir =~ /\/+$/; |
|
Lines 194-206
sub mkdir_recursive ($) {
Link Here
|
| 194 |
if (!-d $dir) { |
194 |
if (!-d $dir) { |
| 195 |
print STDERR "Making directory $dir...\n" unless $quiet; |
195 |
print STDERR "Making directory $dir...\n" unless $quiet; |
| 196 |
# creates with rwxrwxr-x permissions |
196 |
# creates with rwxrwxr-x permissions |
| 197 |
mkdir($dir, 0775) || warn_normal "$dir: $!", undef; |
197 |
mkdir($dir, 0775) || warn_normal("$dir: $!", undef); |
| 198 |
} |
198 |
} |
| 199 |
} |
199 |
} |
| 200 |
|
200 |
|
| 201 |
############################################################################### |
201 |
############################################################################### |
| 202 |
|
202 |
|
| 203 |
sub usage ($) { |
203 |
sub usage { |
| 204 |
my($exitcode) = @_; |
204 |
my($exitcode) = @_; |
| 205 |
my $h = $exitcode? *STDERR: *STDOUT; |
205 |
my $h = $exitcode? *STDERR: *STDOUT; |
| 206 |
print $h <<EOF; |
206 |
print $h <<EOF; |
|
Lines 238-244
EOF
Link Here
|
| 238 |
|
238 |
|
| 239 |
############################################################################### |
239 |
############################################################################### |
| 240 |
|
240 |
|
| 241 |
sub usage_error (;$) { |
241 |
sub usage_error { |
| 242 |
for my $msg (split(/\n/, $_[0])) { |
242 |
for my $msg (split(/\n/, $_[0])) { |
| 243 |
print STDERR "$msg\n"; |
243 |
print STDERR "$msg\n"; |
| 244 |
} |
244 |
} |
|
Lines 260-269
GetOptions(
Link Here
|
| 260 |
'quiet|q' => \$quiet, |
260 |
'quiet|q' => \$quiet, |
| 261 |
'pedantic-warnings|pedantic' => sub { $pedantic_p = 1 }, |
261 |
'pedantic-warnings|pedantic' => sub { $pedantic_p = 1 }, |
| 262 |
'help' => \&usage, |
262 |
'help' => \&usage, |
| 263 |
) || usage_error; |
263 |
) || usage_error(); |
| 264 |
|
264 |
|
| 265 |
VerboseWarnings::set_application_name $0; |
265 |
VerboseWarnings::set_application_name($0); |
| 266 |
VerboseWarnings::set_pedantic_mode $pedantic_p; |
266 |
VerboseWarnings::set_pedantic_mode($pedantic_p); |
| 267 |
|
267 |
|
| 268 |
# keep the buggy Locale::PO quiet if it says stupid things |
268 |
# keep the buggy Locale::PO quiet if it says stupid things |
| 269 |
$SIG{__WARN__} = sub { |
269 |
$SIG{__WARN__} = sub { |
|
Lines 307-313
$href = Locale::PO->load_file_ashash($str_file);
Link Here
|
| 307 |
# guess the charsets. HTML::Templates defaults to iso-8859-1 |
307 |
# guess the charsets. HTML::Templates defaults to iso-8859-1 |
| 308 |
if (defined $href) { |
308 |
if (defined $href) { |
| 309 |
die "$str_file: PO file is corrupted, or not a PO file\n" unless defined $href->{'""'}; |
309 |
die "$str_file: PO file is corrupted, or not a PO file\n" unless defined $href->{'""'}; |
| 310 |
$charset_out = TmplTokenizer::charset_canon $2 if $href->{'""'}->msgstr =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/; |
310 |
$charset_out = TmplTokenizer::charset_canon($2) if $href->{'""'}->msgstr =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/; |
| 311 |
$charset_in = $charset_out; |
311 |
$charset_in = $charset_out; |
| 312 |
# for my $msgid (keys %$href) { |
312 |
# for my $msgid (keys %$href) { |
| 313 |
# if ($msgid =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/) { |
313 |
# if ($msgid =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/) { |
|
Lines 326-347
if (defined $href) {
Link Here
|
| 326 |
next if $id_count == $str_count || |
326 |
next if $id_count == $str_count || |
| 327 |
$msg->{msgstr} eq '""' || |
327 |
$msg->{msgstr} eq '""' || |
| 328 |
grep { /fuzzy/ } @{$msg->{_flags}}; |
328 |
grep { /fuzzy/ } @{$msg->{_flags}}; |
| 329 |
warn_normal |
329 |
warn_normal( |
| 330 |
"unconsistent %s count: ($id_count/$str_count):\n" . |
330 |
"unconsistent %s count: ($id_count/$str_count):\n" . |
| 331 |
" line: " . $msg->{loaded_line_number} . "\n" . |
331 |
" line: " . $msg->{loaded_line_number} . "\n" . |
| 332 |
" msgid: " . $msg->{msgid} . "\n" . |
332 |
" msgid: " . $msg->{msgid} . "\n" . |
| 333 |
" msgstr: " . $msg->{msgstr} . "\n", undef; |
333 |
" msgstr: " . $msg->{msgstr} . "\n", undef); |
| 334 |
} |
334 |
} |
| 335 |
} |
335 |
} |
| 336 |
|
336 |
|
| 337 |
# set our charset in to UTF-8 |
337 |
# set our charset in to UTF-8 |
| 338 |
if (!defined $charset_in) { |
338 |
if (!defined $charset_in) { |
| 339 |
$charset_in = TmplTokenizer::charset_canon 'UTF-8'; |
339 |
$charset_in = TmplTokenizer::charset_canon('UTF-8'); |
| 340 |
warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n" unless ( $quiet ); |
340 |
warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n" unless ( $quiet ); |
| 341 |
} |
341 |
} |
| 342 |
# set our charset out to UTF-8 |
342 |
# set our charset out to UTF-8 |
| 343 |
if (!defined $charset_out) { |
343 |
if (!defined $charset_out) { |
| 344 |
$charset_out = TmplTokenizer::charset_canon 'UTF-8'; |
344 |
$charset_out = TmplTokenizer::charset_canon('UTF-8'); |
| 345 |
warn "Warning: Charset Out defaulting to $charset_out\n" unless ( $quiet ); |
345 |
warn "Warning: Charset Out defaulting to $charset_out\n" unless ( $quiet ); |
| 346 |
} |
346 |
} |
| 347 |
my $xgettext = './xgettext.pl'; # actual text extractor script |
347 |
my $xgettext = './xgettext.pl'; # actual text extractor script |
|
Lines 376-398
if ($action eq 'create') {
Link Here
|
| 376 |
# FIXME: msgmerge(1) is a Unix dependency |
376 |
# FIXME: msgmerge(1) is a Unix dependency |
| 377 |
# FIXME: need to check the return value |
377 |
# FIXME: need to check the return value |
| 378 |
unless (-f $str_file) { |
378 |
unless (-f $str_file) { |
| 379 |
local(*INPUT, *OUTPUT); |
379 |
open(my $infh, '<', $tmpfile2); |
| 380 |
open(INPUT, "<$tmpfile2"); |
380 |
open(my $outfh, '>', $str_file); |
| 381 |
open(OUTPUT, ">$str_file"); |
381 |
while (<$infh>) { |
| 382 |
while (<INPUT>) { |
382 |
print $outfh; |
| 383 |
print OUTPUT; |
|
|
| 384 |
last if /^\n/s; |
383 |
last if /^\n/s; |
| 385 |
} |
384 |
} |
| 386 |
close INPUT; |
385 |
close $infh; |
| 387 |
close OUTPUT; |
386 |
close $outfh; |
| 388 |
} |
387 |
} |
| 389 |
$st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file"); |
388 |
$st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file"); |
| 390 |
} else { |
389 |
} else { |
| 391 |
error_normal "Text extraction failed: $xgettext: $!\n", undef; |
390 |
error_normal("Text extraction failed: $xgettext: $!\n", undef); |
| 392 |
error_additional "Will not run msgmerge\n", undef; |
391 |
error_additional("Will not run msgmerge\n", undef); |
| 393 |
} |
392 |
} |
| 394 |
unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef; |
393 |
unlink $tmpfile1 || warn_normal("$tmpfile1: unlink failed: $!\n", undef); |
| 395 |
unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef; |
394 |
unlink $tmpfile2 || warn_normal("$tmpfile2: unlink failed: $!\n", undef); |
| 396 |
|
395 |
|
| 397 |
} elsif ($action eq 'update') { |
396 |
} elsif ($action eq 'update') { |
| 398 |
my($tmph1, $tmpfile1) = tmpnam(); |
397 |
my($tmph1, $tmpfile1) = tmpnam(); |
|
Lines 421-431
if ($action eq 'create') {
Link Here
|
| 421 |
$st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file"); |
420 |
$st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file"); |
| 422 |
} |
421 |
} |
| 423 |
} else { |
422 |
} else { |
| 424 |
error_normal "Text extraction failed: $xgettext: $!\n", undef; |
423 |
error_normal("Text extraction failed: $xgettext: $!\n", undef); |
| 425 |
error_additional "Will not run msgmerge\n", undef; |
424 |
error_additional("Will not run msgmerge\n", undef); |
| 426 |
} |
425 |
} |
| 427 |
unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef; |
426 |
unlink $tmpfile1 || warn_normal("$tmpfile1: unlink failed: $!\n", undef); |
| 428 |
unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef; |
427 |
unlink $tmpfile2 || warn_normal("$tmpfile2: unlink failed: $!\n", undef); |
| 429 |
|
428 |
|
| 430 |
} elsif ($action eq 'install') { |
429 |
} elsif ($action eq 'install') { |
| 431 |
if(!defined($out_dir)) { |
430 |
if(!defined($out_dir)) { |
|
Lines 448-455
if ($action eq 'create') {
Link Here
|
| 448 |
-d $out_dir || die "$out_dir: The directory does not exist\n"; |
447 |
-d $out_dir || die "$out_dir: The directory does not exist\n"; |
| 449 |
|
448 |
|
| 450 |
# Try to open the file, because Locale::PO doesn't check :-/ |
449 |
# Try to open the file, because Locale::PO doesn't check :-/ |
| 451 |
open(INPUT, "<$str_file") || die "$str_file: $!\n"; |
450 |
open(my $fh, '<', $str_file) || die "$str_file: $!\n"; |
| 452 |
close INPUT; |
451 |
close $fh; |
| 453 |
|
452 |
|
| 454 |
# creates the new tmpl file using the new translation |
453 |
# creates the new tmpl file using the new translation |
| 455 |
for my $input (@in_files) { |
454 |
for my $input (@in_files) { |
|
Lines 457-473
if ($action eq 'create') {
Link Here
|
| 457 |
unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/"; |
456 |
unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/"; |
| 458 |
|
457 |
|
| 459 |
my $target = $out_dir . substr($input, length($in_dir)); |
458 |
my $target = $out_dir . substr($input, length($in_dir)); |
| 460 |
my $targetdir = $` if $target =~ /[^\/]+$/s; |
459 |
my $targetdir = ($target =~ /[^\/]+$/s) ? $` : undef; |
| 461 |
|
460 |
|
| 462 |
if (!defined $type || $input =~ /\.(?:$type)$/) { |
461 |
if (!defined $type || $input =~ /\.(?:$type)$/) { |
| 463 |
my $h = TmplTokenizer->new( $input ); |
462 |
my $h = TmplTokenizer->new( $input ); |
| 464 |
$h->set_allow_cformat( 1 ); |
463 |
$h->set_allow_cformat( 1 ); |
| 465 |
VerboseWarnings::set_input_file_name $input; |
464 |
VerboseWarnings::set_input_file_name($input); |
| 466 |
mkdir_recursive($targetdir) unless -d $targetdir; |
465 |
mkdir_recursive($targetdir) unless -d $targetdir; |
| 467 |
print STDERR "Creating $target...\n" unless $quiet; |
466 |
print STDERR "Creating $target...\n" unless $quiet; |
| 468 |
open( OUTPUT, ">$target" ) || die "$target: $!\n"; |
467 |
open( my $fh, '>', $target ) || die "$target: $!\n"; |
| 469 |
text_replace( $h, *OUTPUT ); |
468 |
text_replace( $h, $fh ); |
| 470 |
close OUTPUT; |
469 |
close $fh; |
| 471 |
} else { |
470 |
} else { |
| 472 |
# just copying the file |
471 |
# just copying the file |
| 473 |
mkdir_recursive($targetdir) unless -d $targetdir; |
472 |
mkdir_recursive($targetdir) unless -d $targetdir; |