2 # This file is part of Koha
3 # Parts copyright 2003-2004 Paul Poulain
4 # Parts copyright 2003-2004 Jerome Vizcaino
5 # Parts copyright 2004 Ambrose Li
9 tmpl_process3.pl - Experimental version of tmpl_process.pl
10 using gettext-compatible translation files
17 use File::Temp qw( :POSIX );
19 use VerboseWarnings qw( error_normal warn_normal );
21 ###############################################################################
23 use vars qw( @in_files $in_dir $str_file $out_dir );
24 use vars qw( @excludes $exclude_regex );
25 use vars qw( $recursive_p );
26 use vars qw( $pedantic_p );
28 use vars qw( $type ); # file extension (DOS form without the dot) to match
29 use vars qw( $charset_in $charset_out );
31 ###############################################################################
33 sub find_translation ($) {
37 $key = TmplTokenizer::string_canon($key);
38 $key = TmplTokenizer::charset_convert($key, $charset_in, $charset_out);
39 $key = TmplTokenizer::quote_po($key);
41 return defined $href->{$key}
42 && !$href->{$key}->fuzzy
43 && length Locale::PO->dequote($href->{$key}->msgstr)?
44 Locale::PO->dequote($href->{$key}->msgstr): $s;
47 sub text_replace_tag ($$) {
50 # value [tag=input], meta
51 my $tag = lc($1) if $t =~ /^<(\S+)/s;
53 for my $a ('alt', 'content', 'title', 'value') {
55 next if $a eq 'content' && $tag ne 'meta';
56 next if $a eq 'value' && ($tag ne 'input'
57 || (ref $attr->{'type'} && $attr->{'type'}->[1] =~ /^(?:hidden|radio)$/)); # FIXME
58 my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
60 my $s = find_translation($val);
61 if ($attr->{$a}->[1] ne $s) { #FIXME
62 $attr->{$a}->[1] = $s; # FIXME
63 $attr->{$a}->[2] = ($s =~ /"/s)? "'$s'": "\"$s\""; #FIXME
72 sprintf(' %s=%s', $_, $attr->{$_}->[2]) #FIXME
74 $attr->{$a}->[3] <=> $attr->{$b}->[3] #FIXME
83 sub text_replace (**) {
86 my $s = TmplTokenizer::next_token $h;
87 last unless defined $s;
88 my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
89 if ($kind eq TmplTokenType::TEXT) {
90 print $output find_translation($t);
91 } elsif ($kind eq TmplTokenType::TEXT_PARAMETRIZED) {
92 my $fmt = find_translation($s->form);
93 print $output TmplTokenizer::parametrize($fmt, [ map {
94 my($kind, $t, $attr) = ($_->type, $_->string, $_->attributes);
95 $kind == TmplTokenType::TAG && %$attr?
96 text_replace_tag($t, $attr): $t } $s->parameters ], [ $s->anchors ]);
97 } elsif ($kind eq TmplTokenType::TAG && %$attr) {
98 print $output text_replace_tag($t, $attr);
99 } elsif (defined $t) {
106 my($dir, $type) = @_;
108 if (opendir(DIR, $dir)) {
109 my @dirent = readdir DIR; # because DIR is shared when recursing
111 for my $dirent (@dirent) {
112 my $path = "$dir/$dirent";
113 if ($dirent =~ /^\./ || $dirent eq 'CVS' || $dirent eq 'RCS'
114 || (defined $exclude_regex && $dirent =~ /^(?:$exclude_regex)$/)) {
117 push @it, $path if !defined $type || $dirent =~ /\.(?:$type)$/;
118 } elsif (-d $path && $recursive_p) {
119 push @it, listfiles($path, $type);
123 warn_normal "$dir: $!", undef;
128 ###############################################################################
130 sub usage_error (;$) {
131 for my $msg (split(/\n/, $_[0])) {
132 print STDERR "$msg\n";
134 print STDERR "Try `$0 --help' for more information.\n";
138 ###############################################################################
141 'input|i=s' => \@in_files,
142 'outputdir|o=s' => \$out_dir,
143 'recursive|r' => \$recursive_p,
144 'str-file|s=s' => \$str_file,
145 'exclude|x=s' => \@excludes,
146 'pedantic-warnings|pedantic' => sub { $pedantic_p = 1 },
149 VerboseWarnings::set_application_name $0;
150 VerboseWarnings::set_pedantic_mode $pedantic_p;
152 # try to make sure .po files are backed up (see BUGS)
153 $ENV{VERSION_CONTROL} = 't';
155 # keep the buggy Locale::PO quiet if it says stupid things
156 $SIG{__WARN__} = sub {
158 print STDERR $s unless $s =~ /^Strange line in [^:]+: #~/s
161 my $action = shift or usage_error('You must specify an ACTION.');
162 usage_error('You must at least specify input and string list filenames.')
163 if !@in_files || !defined $str_file;
165 # Type match defaults to *.tmpl plus *.inc if not specified
166 $type = "tmpl|inc" if !defined($type);
168 # Check the inputs for being files or directories
169 for my $input (@in_files) {
170 usage_error("$input: Input must be a file or directory.\n"
171 . "(Symbolic links are not supported at the moment)")
172 unless -d $input || -f $input;;
175 # Generates the global exclude regular expression
176 $exclude_regex = '(?:'.join('|', @excludes).')' if @excludes;
178 # Generate the list of input files if a directory is specified
179 if (-d $in_files[0]) {
180 die "If you specify a directory as input, you must specify only it.\n"
183 # input is a directory, generates list of files to process
184 $in_dir = $in_files[0];
185 $in_dir =~ s/\/$//; # strips the trailing / if any
186 @in_files = listfiles($in_dir, $type);
188 for my $input (@in_files) {
189 die "You cannot specify input files and directories at the same time.\n"
194 # restores the string list from file
195 $href = Locale::PO->load_file_ashash($str_file);
197 # guess the charsets. HTML::Templates defaults to iso-8859-1
199 $charset_out = TmplTokenizer::charset_canon $2
200 if $href->{'""'}->msgstr =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/;
201 for my $msgid (keys %$href) {
202 if ($msgid =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/) {
203 my $candidate = TmplTokenizer::charset_canon $2;
204 die "Conflicting charsets in msgid: $charset_in vs $candidate\n"
205 if defined $charset_in && $charset_in ne $candidate;
206 $charset_in = $candidate;
210 if (!defined $charset_in) {
211 $charset_in = TmplTokenizer::charset_canon 'iso8859-1';
212 warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n";
215 my $xgettext = './xgettext.pl'; # actual text extractor script
217 if ($action eq 'create') {
218 # updates the list. As the list is empty, every entry will be added
219 die "$str_file: Output file already exists" if -f $str_file;
220 my($tmph, $tmpfile) = tmpnam();
221 # Generate the temporary file that acts as <MODULE>/POTFILES.in
222 for my $input (@in_files) {
223 print $tmph "$input\n";
226 # Generate the specified po file ($str_file)
227 my $st = system ($xgettext, '-s', '-f', $tmpfile, '-o', $str_file);
228 warn_normal "Text extraction failed: $xgettext: $!\n", undef if $st != 0;
229 unlink $tmpfile || warn_normal "$tmpfile: unlink failed: $!\n", undef;
231 } elsif ($action eq 'update') {
232 my($tmph1, $tmpfile1) = tmpnam();
233 my($tmph2, $tmpfile2) = tmpnam();
234 close $tmph2; # We just want a name
235 # Generate the temporary file that acts as <MODULE>/POTFILES.in
236 for my $input (@in_files) {
237 print $tmph1 "$input\n";
240 # Generate the temporary file that acts as <MODULE>/<LANG>.pot
241 my $st = system($xgettext, '-s', '-f', $tmpfile1, '-o', $tmpfile2,
243 (defined $charset_in? ('-I', $charset_in): ()),
244 (defined $charset_out? ('-O', $charset_out): ()));
246 # Merge the temporary "pot file" with the specified po file ($str_file)
247 # FIXME: msgmerge(1) is a Unix dependency
248 # FIXME: need to check the return value
249 system('msgmerge', '-U', '-s', $str_file, $tmpfile2);
251 warn_normal "Text extraction failed: $xgettext: $!\n", undef;
252 warn_normal "Will not run msgmerge\n", undef;
254 unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef;
255 unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef;
257 } elsif ($action eq 'install') {
258 if(!defined($out_dir)) {
259 usage_error("You must specify an output directory when using the install method.");
262 if ($in_dir eq $out_dir) {
263 warn "You must specify a different input and output directory.\n";
267 # Make sure the output directory exists
268 # (It will auto-create it, but for compatibility we should not)
269 -d $out_dir || die "$out_dir: The directory does not exist\n";
271 # Try to open the file, because Locale::PO doesn't check :-/
272 open(INPUT, "<$str_file") || die "$str_file: $!\n";
275 # creates the new tmpl file using the new translation
276 for my $input (@in_files) {
277 die "Assertion failed"
278 unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/";
280 my $h = TmplTokenizer->new( $input );
281 $h->set_allow_cformat( 1 );
282 VerboseWarnings::set_input_file_name $input;
284 my $target = $out_dir . substr($input, length($in_dir));
285 my $targetdir = $` if $target =~ /[^\/]+$/s;
286 if (!-d $targetdir) {
287 print STDERR "Making directory $targetdir...";
288 # creates with rwxrwxr-x permissions
289 mkdir($targetdir, 0775) || warn_normal "$targetdir: $!", undef;
291 print STDERR "Creating $target...\n";
292 open( OUTPUT, ">$target" ) || die "$target: $!\n";
293 text_replace( $h, *OUTPUT );
298 usage_error('Unknown action specified.');
302 ###############################################################################
306 ./tmpl_process3.pl [ I<tmpl_process.pl options> ]
310 This is an experimental version of the tmpl_process.pl script,
311 using standard gettext-style PO files. Note that the behaviour
312 of this script should still be considered unstable.
314 Currently, the create, update, and install actions have all been
315 reimplemented and seem to work.
317 The create action calls xgettext.pl to do the actual work;
318 the update action calls xgettext.pl and msgmerge(1) to do the
321 The script can detect <TMPL_VAR> directives embedded inside what
322 appears to be a full sentence (this actual work being done by
323 TmplTokenizer(3)); these larger patterns appear in the translation
324 file as c-format strings with %s.
326 Whitespace in extracted strings are folded to single blanks, in
327 order to prevent new strings from appearing when minor changes in
328 the original templates occur, and to prevent overly difficult to
329 read strings in the PO file.
333 The --help option has not been implemented yet.
335 xgettext.pl must be present in the current directory; the
336 msgmerge(1) command must also be present in the search path.
337 The script currently does not check carefully whether these
338 dependent commands are present.
340 If xgettext.pl is interrupted by the user, a corrupted po file
341 will result. This is very seriously wrong.
343 Locale::PO(3) has a lot of bugs. It can neither parse nor
344 generate GNU PO files properly; a couple of workarounds have
345 been written in TmplTokenizer and more is likely to be needed
346 (e.g., to get rid of the "Strange line" warning for #~).
348 There are probably some other bugs too, since this has not been