Bug 5236 Followup: items table information being keyed by biblionumber instead!
[wip/koha-chris_n.git] / misc / translator / text-extract2.pl
1 #!/usr/bin/perl
2
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.
7
8 # This script is meant to be a drop-in replacement of text-extract.pl
9
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
16
17 use strict;
18 #use warnings; FIXME - Bug 2505
19 use Getopt::Long;
20 use TmplTokenizer;
21 use VerboseWarnings;
22
23 use vars qw( $input );
24 use vars qw( $debug_dump_only_p );
25 use vars qw( $pedantic_p );
26 use vars qw( $allow_cformat_p ); # FOR TESTING PURPOSES ONLY!!
27
28 ###############################################################################
29
30 sub underline ($) { # for testing only
31     my($s) = @_;
32     join('', map {/[\0-\37]/? $_: "$_\b$_"} split(//, $s));
33 }
34
35 sub debug_dump ($) { # for testing only
36     my($h) = @_;
37     print "re_tag_compat is /", TmplTokenizer::re_tag(1), "/\n";
38     for (;;) {
39         my $s = TmplTokenizer::next_token $h;
40     last unless defined $s;
41         printf "%s\n", ('-' x 79);
42         my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
43         printf "%s [line %d]:\n", $kind->to_string, $s->line_number;
44         printf "%4dH%s\n", length($t), underline($t);
45         if ($kind == TmplTokenType::TAG && %$attr) {
46             printf "Attributes:\n";
47             for my $a (keys %$attr) {
48                 my($key, $val, $val_orig, $order) = @{$attr->{$a}};
49                 printf "%s = %dH%s -- %s\n", $a, length $val, underline $val,
50                 $val_orig;
51             }
52         }
53         if ($kind == TmplTokenType::TEXT_PARAMETRIZED) {
54             printf "Form (c-format string):\n";
55             printf "%dH%s\n", length $s->form, underline $s->form;
56             printf "Parameters:\n";
57             my $i = 1;
58             for my $a ($s->parameters) {
59                 my $t = $a->string;
60                 printf "%%%d\$s = %dH%s\n", $i, length $t, underline $t;
61                 $i += 1;
62             }
63         }
64         if ($s->has_js_data) {
65             printf "JavaScript translatable strings:\n";
66             for my $t (@{$s->js_data}) {
67                 printf "%dH%s\n", length $t->[3], underline $t->[3] if $t->[0]; # FIXME
68             }
69         }
70     }
71 }
72
73 ###############################################################################
74
75 sub text_extract ($) {
76     my($h) = @_;
77     my %text = ();
78     for (;;) {
79         my $s = TmplTokenizer::next_token $h;
80     last unless defined $s;
81         my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
82         if ($kind == TmplTokenType::TEXT) {
83             $t = TmplTokenizer::trim $t;
84             $text{$t} = 1 if $t =~ /\S/s;
85         } elsif ($kind == TmplTokenType::TAG && %$attr) {
86             # value [tag=input], meta
87             my $tag = lc($1) if $t =~ /^<(\S+)/s;
88             for my $a ('alt', 'content', 'title', 'value') {
89                 if ($attr->{$a}) {
90                     next if $a eq 'content' && $tag ne 'meta';
91                     next if $a eq 'value' && ($tag ne 'input'
92                         || (ref $attr->{'type'} && $attr->{'type'}->[1] =~ /^(?:hidden|radio)$/)); # FIXME
93                     my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
94                     $val = TmplTokenizer::trim $val;
95                     $text{$val} = 1 if $val =~ /\S/s;
96                 }
97             }
98         } elsif ($s->has_js_data) {
99             for my $t (@{$s->js_data}) {
100                 remember( $s, $t->[3] ) if $t->[0]; # FIXME
101             }
102         }
103     }
104     # Emit all extracted strings.
105     # Don't emit pure whitespace, pure numbers, or TMPL_VAR's.
106     for my $t (keys %text) {
107         printf "%s\n", $t
108             unless TmplTokenizer::blank_p($t) || $t =~ /^\d+$/;
109     }
110 }
111
112 ###############################################################################
113
114 sub usage ($) {
115     my($exitcode) = @_;
116     my $h = $exitcode? *STDERR: *STDOUT;
117     print $h <<EOF;
118 Usage: $0 [OPTIONS]
119 Extract strings from HTML file.
120
121       --debug-dump-only     Do not extract strings; but display scanned tokens
122   -f, --file=FILE           Extract from the specified FILE
123       --pedantic-warnings   Issue warnings even for detected problems which
124                             are likely to be harmless
125       --help                Display this help and exit
126 EOF
127     exit($exitcode);
128 }
129
130 ###############################################################################
131
132 sub usage_error (;$) {
133     print STDERR "$_[0]\n" if @_;
134     print STDERR "Try `$0 --help' for more information.\n";
135     exit(-1);
136 }
137
138 ###############################################################################
139
140 GetOptions(
141     'enable-cformat'    => \$allow_cformat_p,
142     'f|file=s'          => \$input,
143     'debug-dump-only'   => \$debug_dump_only_p,
144     'pedantic-warnings' => sub { $pedantic_p = 1 },
145     'help'              => sub { usage(0) },
146 ) || usage_error;
147
148 VerboseWarnings::set_application_name $0;
149 VerboseWarnings::set_input_file_name $input;
150 VerboseWarnings::set_pedantic_mode $pedantic_p;
151
152 usage_error('Missing mandatory option -f') unless defined $input;
153
154 my $h = TmplTokenizer->new( $input );
155 $h->set_allow_cformat( 1 ) if $allow_cformat_p;
156 if ($debug_dump_only_p) {
157     debug_dump( $h );
158 } else {
159     text_extract( $h );
160 }
161
162 warn "This input will not work with Mozilla standards-compliant mode\n", undef
163         if TmplTokenizer::syntaxerror_p;
164
165 close INPUT;
166
167 exit(-1) if TmplTokenizer::fatal_p;