|
Lines 24-32
use vars qw( $disable_fuzzy_p );
Link Here
|
| 24 |
use vars qw( $verbose_p ); |
24 |
use vars qw( $verbose_p ); |
| 25 |
use vars qw( $po_mode_p ); |
25 |
use vars qw( $po_mode_p ); |
| 26 |
|
26 |
|
|
|
27 |
our $OUTPUT; |
| 28 |
|
| 27 |
############################################################################### |
29 |
############################################################################### |
| 28 |
|
30 |
|
| 29 |
sub string_negligible_p ($) { |
31 |
sub string_negligible_p { |
| 30 |
my($t) = @_; # a string |
32 |
my($t) = @_; # a string |
| 31 |
# Don't emit pure whitespace, pure numbers, pure punctuation, |
33 |
# Don't emit pure whitespace, pure numbers, pure punctuation, |
| 32 |
# single letters, or TMPL_VAR's. |
34 |
# single letters, or TMPL_VAR's. |
|
Lines 41-47
sub string_negligible_p ($) {
Link Here
|
| 41 |
) |
43 |
) |
| 42 |
} |
44 |
} |
| 43 |
|
45 |
|
| 44 |
sub token_negligible_p( $ ) { |
46 |
sub token_negligible_p { |
| 45 |
my($x) = @_; |
47 |
my($x) = @_; |
| 46 |
my $t = $x->type; |
48 |
my $t = $x->type; |
| 47 |
return !$extract_all_p && ( |
49 |
return !$extract_all_p && ( |
|
Lines 57-63
sub token_negligible_p( $ ) {
Link Here
|
| 57 |
|
59 |
|
| 58 |
############################################################################### |
60 |
############################################################################### |
| 59 |
|
61 |
|
| 60 |
sub remember ($$) { |
62 |
sub remember { |
| 61 |
my($token, $string) = @_; |
63 |
my($token, $string) = @_; |
| 62 |
# If we determine that the string is negligible, don't bother to remember |
64 |
# If we determine that the string is negligible, don't bother to remember |
| 63 |
unless (string_negligible_p( $string ) || token_negligible_p( $token )) { |
65 |
unless (string_negligible_p( $string ) || token_negligible_p( $token )) { |
|
Lines 69-75
sub remember ($$) {
Link Here
|
| 69 |
|
71 |
|
| 70 |
############################################################################### |
72 |
############################################################################### |
| 71 |
|
73 |
|
| 72 |
sub string_list () { |
74 |
sub string_list { |
| 73 |
my @t = keys %text; |
75 |
my @t = keys %text; |
| 74 |
# The real gettext tools seems to sort case sensitively; I don't know why |
76 |
# The real gettext tools seems to sort case sensitively; I don't know why |
| 75 |
@t = sort { $a cmp $b } @t if $sort eq 's'; |
77 |
@t = sort { $a cmp $b } @t if $sort eq 's'; |
|
Lines 86-92
sub string_list () {
Link Here
|
| 86 |
|
88 |
|
| 87 |
############################################################################### |
89 |
############################################################################### |
| 88 |
|
90 |
|
| 89 |
sub text_extract (*) { |
91 |
sub text_extract { |
| 90 |
my($h) = @_; |
92 |
my($h) = @_; |
| 91 |
for (;;) { |
93 |
for (;;) { |
| 92 |
my $s = TmplTokenizer::next_token $h; |
94 |
my $s = TmplTokenizer::next_token $h; |
|
Lines 102-108
sub text_extract (*) {
Link Here
|
| 102 |
} |
104 |
} |
| 103 |
} elsif ($kind eq C4::TmplTokenType::TAG && %$attr) { |
105 |
} elsif ($kind eq C4::TmplTokenType::TAG && %$attr) { |
| 104 |
# value [tag=input], meta |
106 |
# value [tag=input], meta |
| 105 |
my $tag = lc($1) if $t =~ /^<(\S+)/s; |
107 |
my $tag; |
|
|
108 |
$tag = lc($1) if $t =~ /^<(\S+)/s; |
| 106 |
for my $a ('alt', 'content', 'title', 'value', 'label', 'placeholder') { |
109 |
for my $a ('alt', 'content', 'title', 'value', 'label', 'placeholder') { |
| 107 |
if ($attr->{$a}) { |
110 |
if ($attr->{$a}) { |
| 108 |
next if $a eq 'label' && $tag ne 'optgroup'; |
111 |
next if $a eq 'label' && $tag ne 'optgroup'; |
|
Lines 124-139
sub text_extract (*) {
Link Here
|
| 124 |
|
127 |
|
| 125 |
############################################################################### |
128 |
############################################################################### |
| 126 |
|
129 |
|
| 127 |
sub generate_strings_list () { |
130 |
sub generate_strings_list { |
| 128 |
# Emit all extracted strings. |
131 |
# Emit all extracted strings. |
| 129 |
for my $t (string_list) { |
132 |
for my $t (string_list) { |
| 130 |
printf OUTPUT "%s\n", $t; |
133 |
printf $OUTPUT "%s\n", $t; |
| 131 |
} |
134 |
} |
| 132 |
} |
135 |
} |
| 133 |
|
136 |
|
| 134 |
############################################################################### |
137 |
############################################################################### |
| 135 |
|
138 |
|
| 136 |
sub generate_po_file () { |
139 |
sub generate_po_file { |
| 137 |
# We don't emit the Plural-Forms header; it's meaningless for us |
140 |
# We don't emit the Plural-Forms header; it's meaningless for us |
| 138 |
my $pot_charset = (defined $charset_out? $charset_out: 'CHARSET'); |
141 |
my $pot_charset = (defined $charset_out? $charset_out: 'CHARSET'); |
| 139 |
$pot_charset = TmplTokenizer::charset_canon $pot_charset; |
142 |
$pot_charset = TmplTokenizer::charset_canon $pot_charset; |
|
Lines 141-157
sub generate_po_file () {
Link Here
|
| 141 |
my $time = POSIX::strftime('%Y-%m-%d %H:%M%z', localtime(time)); |
144 |
my $time = POSIX::strftime('%Y-%m-%d %H:%M%z', localtime(time)); |
| 142 |
my $time_pot = $time; |
145 |
my $time_pot = $time; |
| 143 |
my $time_po = $po_mode_p? $time: 'YEAR-MO-DA HO:MI+ZONE'; |
146 |
my $time_po = $po_mode_p? $time: 'YEAR-MO-DA HO:MI+ZONE'; |
| 144 |
print OUTPUT <<EOF; |
147 |
print $OUTPUT <<EOF; |
| 145 |
# SOME DESCRIPTIVE TITLE. |
148 |
# SOME DESCRIPTIVE TITLE. |
| 146 |
# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER |
149 |
# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER |
| 147 |
# This file is distributed under the same license as the PACKAGE package. |
150 |
# This file is distributed under the same license as the PACKAGE package. |
| 148 |
# FIRST AUTHOR <EMAIL\@ADDRESS>, YEAR. |
151 |
# FIRST AUTHOR <EMAIL\@ADDRESS>, YEAR. |
| 149 |
# |
152 |
# |
| 150 |
EOF |
153 |
EOF |
| 151 |
print OUTPUT <<EOF unless $disable_fuzzy_p; |
154 |
print $OUTPUT <<EOF unless $disable_fuzzy_p; |
| 152 |
#, fuzzy |
155 |
#, fuzzy |
| 153 |
EOF |
156 |
EOF |
| 154 |
print OUTPUT <<EOF; |
157 |
print $OUTPUT <<EOF; |
| 155 |
msgid "" |
158 |
msgid "" |
| 156 |
msgstr "" |
159 |
msgstr "" |
| 157 |
"Project-Id-Version: PACKAGE VERSION\\n" |
160 |
"Project-Id-Version: PACKAGE VERSION\\n" |
|
Lines 168-174
EOF
Link Here
|
| 168 |
for my $t (string_list) { |
171 |
for my $t (string_list) { |
| 169 |
if ($text{$t}->[0]->type == C4::TmplTokenType::TEXT_PARAMETRIZED) { |
172 |
if ($text{$t}->[0]->type == C4::TmplTokenType::TEXT_PARAMETRIZED) { |
| 170 |
my($token, $n) = ($text{$t}->[0], 0); |
173 |
my($token, $n) = ($text{$t}->[0], 0); |
| 171 |
printf OUTPUT "#. For the first occurrence,\n" |
174 |
printf $OUTPUT "#. For the first occurrence,\n" |
| 172 |
if @{$text{$t}} > 1 && $token->parameters_and_fields > 0; |
175 |
if @{$text{$t}} > 1 && $token->parameters_and_fields > 0; |
| 173 |
for my $param ($token->parameters_and_fields) { |
176 |
for my $param ($token->parameters_and_fields) { |
| 174 |
$n += 1; |
177 |
$n += 1; |
|
Lines 183-243
EOF
Link Here
|
| 183 |
$type = $param->string =~ /\[%(.*?)%\]/is? $1: 'ERROR'; |
186 |
$type = $param->string =~ /\[%(.*?)%\]/is? $1: 'ERROR'; |
| 184 |
my $name = $param->string =~ /\bname=(["']?)([^\s"']+)\1/is? |
187 |
my $name = $param->string =~ /\bname=(["']?)([^\s"']+)\1/is? |
| 185 |
$2: undef; |
188 |
$2: undef; |
| 186 |
printf OUTPUT "#. %s: %s\n", $fmt, |
189 |
printf $OUTPUT "#. %s: %s\n", $fmt, |
| 187 |
"$type" . (defined $name? " name=$name": ''); |
190 |
"$type" . (defined $name? " name=$name": ''); |
| 188 |
} else { |
191 |
} else { |
| 189 |
my $name = $param->attributes->{'name'}; |
192 |
my $name = $param->attributes->{'name'}; |
| 190 |
my $value = $param->attributes->{'value'} |
193 |
my $value; |
|
|
194 |
$value = $param->attributes->{'value'} |
| 191 |
unless $subtype =~ /^(?:text)$/; |
195 |
unless $subtype =~ /^(?:text)$/; |
| 192 |
printf OUTPUT "#. %s: %s\n", $fmt, "type=$subtype" |
196 |
printf $OUTPUT "#. %s: %s\n", $fmt, "type=$subtype" |
| 193 |
. (defined $name? " name=$name->[1]": '') |
197 |
. (defined $name? " name=$name->[1]": '') |
| 194 |
. (defined $value? " value=$value->[1]": ''); |
198 |
. (defined $value? " value=$value->[1]": ''); |
| 195 |
} |
199 |
} |
| 196 |
} |
200 |
} |
| 197 |
} elsif ($text{$t}->[0]->type == C4::TmplTokenType::TAG) { |
201 |
} elsif ($text{$t}->[0]->type == C4::TmplTokenType::TAG) { |
| 198 |
my($token) = ($text{$t}->[0]); |
202 |
my($token) = ($text{$t}->[0]); |
| 199 |
printf OUTPUT "#. For the first occurrence,\n" |
203 |
printf $OUTPUT "#. For the first occurrence,\n" |
| 200 |
if @{$text{$t}} > 1 && $token->parameters_and_fields > 0; |
204 |
if @{$text{$t}} > 1 && $token->parameters_and_fields > 0; |
| 201 |
if ($token->string =~ /^<meta\b/is) { |
205 |
if ($token->string =~ /^<meta\b/is) { |
| 202 |
my $type = $token->attributes->{'http-equiv'}->[1]; |
206 |
my $type = $token->attributes->{'http-equiv'}->[1]; |
| 203 |
print OUTPUT "#. META http-equiv=$type\n" if defined $type; |
207 |
print $OUTPUT "#. META http-equiv=$type\n" if defined $type; |
| 204 |
} elsif ($token->string =~ /^<([a-z0-9]+)/is) { |
208 |
} elsif ($token->string =~ /^<([a-z0-9]+)/is) { |
| 205 |
my $tag = uc($1); |
209 |
my $tag = uc($1); |
| 206 |
my $type = (lc($tag) eq 'input'? |
210 |
my $type = (lc($tag) eq 'input'? |
| 207 |
$token->attributes->{'type'}: undef); |
211 |
$token->attributes->{'type'}: undef); |
| 208 |
my $name = $token->attributes->{'name'}; |
212 |
my $name = $token->attributes->{'name'}; |
| 209 |
printf OUTPUT "#. %s\n", $tag |
213 |
printf $OUTPUT "#. %s\n", $tag |
| 210 |
. (defined $type? " type=$type->[1]": '') |
214 |
. (defined $type? " type=$type->[1]": '') |
| 211 |
. (defined $name? " name=$name->[1]": ''); |
215 |
. (defined $name? " name=$name->[1]": ''); |
| 212 |
} |
216 |
} |
| 213 |
} elsif ($text{$t}->[0]->has_js_data) { |
217 |
} elsif ($text{$t}->[0]->has_js_data) { |
| 214 |
printf OUTPUT "#. For the first occurrence,\n" if @{$text{$t}} > 1; |
218 |
printf $OUTPUT "#. For the first occurrence,\n" if @{$text{$t}} > 1; |
| 215 |
printf OUTPUT "#. SCRIPT\n"; |
219 |
printf $OUTPUT "#. SCRIPT\n"; |
| 216 |
} |
220 |
} |
| 217 |
my $cformat_p; |
221 |
my $cformat_p; |
| 218 |
for my $token (@{$text{$t}}) { |
222 |
for my $token (@{$text{$t}}) { |
| 219 |
my $pathname = $token->pathname; |
223 |
my $pathname = $token->pathname; |
| 220 |
$pathname =~ s/^$directory_re//os; |
224 |
$pathname =~ s/^$directory_re//os; |
| 221 |
$pathname =~ s/^.*\/koha-tmpl\/(.*)$/$1/; |
225 |
$pathname =~ s/^.*\/koha-tmpl\/(.*)$/$1/; |
| 222 |
printf OUTPUT "#: %s:%d\n", $pathname, $token->line_number |
226 |
printf $OUTPUT "#: %s:%d\n", $pathname, $token->line_number |
| 223 |
if defined $pathname && defined $token->line_number; |
227 |
if defined $pathname && defined $token->line_number; |
| 224 |
$cformat_p = 1 if $token->type == C4::TmplTokenType::TEXT_PARAMETRIZED; |
228 |
$cformat_p = 1 if $token->type == C4::TmplTokenType::TEXT_PARAMETRIZED; |
| 225 |
} |
229 |
} |
| 226 |
printf OUTPUT "#, c-format\n" if $cformat_p; |
230 |
printf $OUTPUT "#, c-format\n" if $cformat_p; |
| 227 |
printf OUTPUT "msgid %s\n", TmplTokenizer::quote_po |
231 |
printf $OUTPUT "msgid %s\n", TmplTokenizer::quote_po |
| 228 |
TmplTokenizer::string_canon |
232 |
TmplTokenizer::string_canon |
| 229 |
TmplTokenizer::charset_convert $t, $charset_in, $charset_out; |
233 |
TmplTokenizer::charset_convert $t, $charset_in, $charset_out; |
| 230 |
printf OUTPUT "msgstr %s\n\n", (defined $translation{$t}? |
234 |
printf $OUTPUT "msgstr %s\n\n", (defined $translation{$t}? |
| 231 |
TmplTokenizer::quote_po( $translation{$t} ): "\"\""); |
235 |
TmplTokenizer::quote_po( $translation{$t} ): "\"\""); |
| 232 |
} |
236 |
} |
| 233 |
} |
237 |
} |
| 234 |
|
238 |
|
| 235 |
############################################################################### |
239 |
############################################################################### |
| 236 |
|
240 |
|
| 237 |
sub convert_translation_file () { |
241 |
sub convert_translation_file { |
| 238 |
open(INPUT, "<$convert_from") || die "$convert_from: $!\n"; |
242 |
open(my $INPUT, '<', $convert_from) || die "$convert_from: $!\n"; |
| 239 |
VerboseWarnings::set_input_file_name $convert_from; |
243 |
VerboseWarnings::set_input_file_name $convert_from; |
| 240 |
while (<INPUT>) { |
244 |
while (<$INPUT>) { |
| 241 |
chomp; |
245 |
chomp; |
| 242 |
my($msgid, $msgstr) = split(/\t/); |
246 |
my($msgid, $msgstr) = split(/\t/); |
| 243 |
die "$convert_from: $.: Malformed tmpl_process input (no tab)\n" |
247 |
die "$convert_from: $.: Malformed tmpl_process input (no tab)\n" |
|
Lines 274-280
sub convert_translation_file () {
Link Here
|
| 274 |
|
278 |
|
| 275 |
############################################################################### |
279 |
############################################################################### |
| 276 |
|
280 |
|
| 277 |
sub usage ($) { |
281 |
sub usage { |
| 278 |
my($exitcode) = @_; |
282 |
my($exitcode) = @_; |
| 279 |
my $h = $exitcode? *STDERR: *STDOUT; |
283 |
my $h = $exitcode? *STDERR: *STDOUT; |
| 280 |
print $h <<EOF; |
284 |
print $h <<EOF; |
|
Lines 308-314
EOF
Link Here
|
| 308 |
|
312 |
|
| 309 |
############################################################################### |
313 |
############################################################################### |
| 310 |
|
314 |
|
| 311 |
sub usage_error (;$) { |
315 |
sub usage_error { |
| 312 |
print STDERR "$_[0]\n" if @_; |
316 |
print STDERR "$_[0]\n" if @_; |
| 313 |
print STDERR "Try `$0 --help' for more information.\n"; |
317 |
print STDERR "Try `$0 --help' for more information.\n"; |
| 314 |
exit(-1); |
318 |
exit(-1); |
|
Lines 347-363
usage_error('You cannot specify both --convert-from and --files-from')
Link Here
|
| 347 |
|
351 |
|
| 348 |
if (defined $output && $output ne '-') { |
352 |
if (defined $output && $output ne '-') { |
| 349 |
print STDERR "$0: Opening output file \"$output\"\n" if $verbose_p; |
353 |
print STDERR "$0: Opening output file \"$output\"\n" if $verbose_p; |
| 350 |
open(OUTPUT, ">$output") || die "$output: $!\n"; |
354 |
open($OUTPUT, '>', $output) || die "$output: $!\n"; |
| 351 |
} else { |
355 |
} else { |
| 352 |
print STDERR "$0: Outputting to STDOUT...\n" if $verbose_p; |
356 |
print STDERR "$0: Outputting to STDOUT...\n" if $verbose_p; |
| 353 |
open(OUTPUT, ">&STDOUT"); |
357 |
open($OUTPUT, ">&STDOUT"); |
| 354 |
} |
358 |
} |
| 355 |
#binmode OUTPUT, ':encoding(UTF-8)'; |
|
|
| 356 |
|
359 |
|
| 357 |
if (defined $files_from) { |
360 |
if (defined $files_from) { |
| 358 |
print STDERR "$0: Opening input file list \"$files_from\"\n" if $verbose_p; |
361 |
print STDERR "$0: Opening input file list \"$files_from\"\n" if $verbose_p; |
| 359 |
open(INPUT, "<$files_from") || die "$files_from: $!\n"; |
362 |
open(my $INPUT, '<', $files_from) || die "$files_from: $!\n"; |
| 360 |
while (<INPUT>) { |
363 |
while (<$INPUT>) { |
| 361 |
chomp; |
364 |
chomp; |
| 362 |
my $input = /^\//? $_: "$directory/$_"; |
365 |
my $input = /^\//? $_: "$directory/$_"; |
| 363 |
my $h = TmplTokenizer->new( $input ); |
366 |
my $h = TmplTokenizer->new( $input ); |
|
Lines 366-372
if (defined $files_from) {
Link Here
|
| 366 |
print STDERR "$0: Processing file \"$input\"\n" if $verbose_p; |
369 |
print STDERR "$0: Processing file \"$input\"\n" if $verbose_p; |
| 367 |
text_extract( $h ); |
370 |
text_extract( $h ); |
| 368 |
} |
371 |
} |
| 369 |
close INPUT; |
372 |
close $INPUT; |
| 370 |
} else { |
373 |
} else { |
| 371 |
print STDERR "$0: Converting \"$convert_from\"\n" if $verbose_p; |
374 |
print STDERR "$0: Converting \"$convert_from\"\n" if $verbose_p; |
| 372 |
convert_translation_file; |
375 |
convert_translation_file; |
| 373 |
- |
|
|