View | Details | Raw Unified | Return to bug 12301
Collapse All | Expand All

(-)a/misc/translator/TmplTokenizer.pm (-1 / +1 lines)
Lines 471-477 sub trim ($) { Link Here
471
sub quote_po ($) {
471
sub quote_po ($) {
472
    my($s) = @_;
472
    my($s) = @_;
473
    # Locale::PO->quote is buggy, it doesn't quote newlines :-/
473
    # Locale::PO->quote is buggy, it doesn't quote newlines :-/
474
    $s =~ s/([\\"])/\\\1/gs;
474
    $s =~ s/([\\"])/\\$1/gs;
475
    $s =~ s/\n/\\n/g;
475
    $s =~ s/\n/\\n/g;
476
    #$s =~ s/[\177-\377]/ sprintf("\\%03o", ord($&)) /egs;
476
    #$s =~ s/[\177-\377]/ sprintf("\\%03o", ord($&)) /egs;
477
    return "\"$s\"";
477
    return "\"$s\"";
(-)a/misc/translator/translate (-1 / +1 lines)
Lines 51-57 my ($cmd, $lang) = @ARGV; Link Here
51
$cmd = lc $cmd;
51
$cmd = lc $cmd;
52
if ( $cmd =~ /create|install|update/ ) {
52
if ( $cmd =~ /create|install|update/ ) {
53
    my $installer = LangInstaller->new( $lang, $pref, $verbose );
53
    my $installer = LangInstaller->new( $lang, $pref, $verbose );
54
    if ( $cmd !~ /create/ && $lang && not $lang ~~ $installer->{langs} ) {
54
    if ( $cmd ne 'create' and $lang and not grep( /^$lang$/, @{ $installer->{langs} } ) ) {
55
        print "Unsupported language: $lang\n";
55
        print "Unsupported language: $lang\n";
56
        exit;
56
        exit;
57
    }
57
    }
(-)a/misc/translator/xgettext.pl (-37 / +39 lines)
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
- 

Return to bug 12301