3 # Test filter partially based on Ambrose's hideous subst.pl code
4 # The idea is that the .tmpl files are not valid HTML, and as a result
5 # HTML::Parse would be completely confused by these templates.
6 # This is just a simple scanner (not a parser) & should give better results.
8 # This script is meant to be a drop-in replacement of text-extract.pl
10 # A grander plan: Code could be written to detect template variables and
11 # construct gettext-c-format-string-like meta-strings (e.g., "Results %s
12 # through %s of %s records" that will be more likely to be translatable
13 # to languages where word order is very unlike English word order.
14 # --> This will be relatively major rework, and requires corresponding
15 # rework in tmpl_process.pl
22 use vars qw( $input );
23 use vars qw( $debug_dump_only_p );
24 use vars qw( $pedantic_p );
25 use vars qw( $allow_cformat_p ); # FOR TESTING PURPOSES ONLY!!
27 ###############################################################################
29 sub underline ($) { # for testing only
31 join('', map {/[\0-\37]/? $_: "$_\b$_"} split(//, $s));
34 sub debug_dump ($) { # for testing only
36 print "re_tag_compat is /", TmplTokenizer::re_tag(1), "/\n";
38 my $s = TmplTokenizer::next_token $h;
39 last unless defined $s;
40 printf "%s\n", ('-' x 79);
41 my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
42 printf "%s [line %d]:\n", $kind->to_string, $s->line_number;
43 printf "%4dH%s\n", length($t), underline($t);
44 if ($kind == TmplTokenType::TAG && %$attr) {
45 printf "Attributes:\n";
46 for my $a (keys %$attr) {
47 my($key, $val, $val_orig, $order) = @{$attr->{$a}};
48 printf "%s = %dH%s -- %s\n", $a, length $val, underline $val,
52 if ($kind == TmplTokenType::TEXT_PARAMETRIZED) {
53 printf "Form (c-format string):\n";
54 printf "%dH%s\n", length $s->form, underline $s->form;
55 printf "Parameters:\n";
57 for my $a ($s->parameters) {
59 printf "%%%d\$s = %dH%s\n", $i, length $t, underline $t;
66 ###############################################################################
68 sub text_extract ($) {
72 my $s = TmplTokenizer::next_token $h;
73 last unless defined $s;
74 my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
75 if ($kind == TmplTokenType::TEXT) {
76 $t = TmplTokenizer::trim $t;
77 $text{$t} = 1 if $t =~ /\S/s;
78 } elsif ($kind == TmplTokenType::TAG && %$attr) {
79 # value [tag=input], meta
80 my $tag = lc($1) if $t =~ /^<(\S+)/s;
81 for my $a ('alt', 'content', 'title', 'value') {
83 next if $a eq 'content' && $tag ne 'meta';
84 next if $a eq 'value' && ($tag ne 'input'
85 || (ref $attr->{'type'} && $attr->{'type'}->[1] =~ /^(?:hidden|radio)$/)); # FIXME
86 my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
87 $val = TmplTokenizer::trim $val;
88 $text{$val} = 1 if $val =~ /\S/s;
93 # Emit all extracted strings.
94 # Don't emit pure whitespace, pure numbers, or TMPL_VAR's.
95 for my $t (keys %text) {
97 unless TmplTokenizer::blank_p($t) || $t =~ /^\d+$/;
101 ###############################################################################
105 my $h = $exitcode? *STDERR: *STDOUT;
108 Extract strings from HTML file.
110 --debug-dump-only Do not extract strings; but display scanned tokens
111 -f, --file=FILE Extract from the specified FILE
112 --pedantic-warnings Issue warnings even for detected problems which
113 are likely to be harmless
114 --help Display this help and exit
119 ###############################################################################
121 sub usage_error (;$) {
122 print STDERR "$_[0]\n" if @_;
123 print STDERR "Try `$0 --help' for more information.\n";
127 ###############################################################################
130 'enable-cformat' => \$allow_cformat_p,
131 'f|file=s' => \$input,
132 'debug-dump-only' => \$debug_dump_only_p,
133 'pedantic-warnings' => sub { $pedantic_p = 1 },
134 'help' => sub { usage(0) },
137 VerboseWarnings::set_application_name $0;
138 VerboseWarnings::set_input_file_name $input;
139 VerboseWarnings::set_pedantic_mode $pedantic_p;
141 usage_error('Missing mandatory option -f') unless defined $input;
143 my $h = TmplTokenizer->new( $input );
144 $h->set_allow_cformat( 1 ) if $allow_cformat_p;
145 if ($debug_dump_only_p) {
151 warn "This input will not work with Mozilla standards-compliant mode\n", undef
152 if TmplTokenizer::syntaxerror_p;
156 exit(-1) if TmplTokenizer::fatal_p;