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 ($) {
35 my $key = TmplTokenizer::quote_po($s) if $s =~ /\S/;
36 $key = TmplTokenizer::charset_convert($key, $charset_in, $charset_out);
37 return defined $href->{$key}
38 && !$href->{$key}->fuzzy
39 && length Locale::PO->dequote($href->{$key}->msgstr)?
40 Locale::PO->dequote($href->{$key}->msgstr): $s;
43 sub text_replace_tag ($$) {
46 # value [tag=input], meta
47 my $tag = lc($1) if $t =~ /^<(\S+)/s;
49 for my $a ('alt', 'content', 'title', 'value') {
51 next if $a eq 'content' && $tag ne 'meta';
52 next if $a eq 'value' && ($tag ne 'input'
53 || (ref $attr->{'type'} && $attr->{'type'}->[1] =~ /^(?:hidden|radio)$/)); # FIXME
54 my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
55 my($pre, $trimmed, $post) = TmplTokenizer::trim $val;
57 my $s = $pre . find_translation($trimmed) . $post;
58 if ($attr->{$a}->[1] ne $s) { #FIXME
59 $attr->{$a}->[1] = $s; # FIXME
60 $attr->{$a}->[2] = ($s =~ /"/s)? "'$s'": "\"$s\""; #FIXME
69 sprintf(' %s=%s', $_, $attr->{$_}->[2]) #FIXME
71 $attr->{$a}->[3] <=> $attr->{$b}->[3] #FIXME
80 sub text_replace (**) {
83 my $s = TmplTokenizer::next_token $h;
84 last unless defined $s;
85 my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
86 if ($kind eq TmplTokenType::TEXT) {
87 my($pre, $trimmed, $post) = TmplTokenizer::trim $t;
88 print $output $pre, find_translation($trimmed), $post;
89 } elsif ($kind eq TmplTokenType::TEXT_PARAMETRIZED) {
90 my $fmt = find_translation($s->form);
91 print $output TmplTokenizer::parametrize($fmt, map {
92 my($kind, $t, $attr) = ($_->type, $_->string, $_->attributes);
93 $kind == TmplTokenType::TAG && %$attr?
94 text_replace_tag($t, $attr): $t } $s->parameters);
95 } elsif ($kind eq TmplTokenType::TAG && %$attr) {
96 print $output text_replace_tag($t, $attr);
97 } elsif (defined $t) {
104 my($dir, $type) = @_;
106 if (opendir(DIR, $dir)) {
107 my @dirent = readdir DIR; # because DIR is shared when recursing
109 for my $dirent (@dirent) {
110 my $path = "$dir/$dirent";
111 if ($dirent =~ /^\./ || $dirent eq 'CVS' || $dirent eq 'RCS'
112 || (defined $exclude_regex && $dirent =~ /^(?:$exclude_regex)$/)) {
115 push @it, $path if !defined $type || $dirent =~ /\.(?:$type)$/;
116 } elsif (-d $path && $recursive_p) {
117 push @it, listfiles($path, $type);
121 warn_normal "$dir: $!", undef;
126 ###############################################################################
128 sub usage_error (;$) {
129 for my $msg (split(/\n/, $_[0])) {
130 print STDERR "$msg\n";
132 print STDERR "Try `$0 --help' for more information.\n";
136 ###############################################################################
139 'input|i=s' => \@in_files,
140 'outputdir|o=s' => \$out_dir,
141 'recursive|r' => \$recursive_p,
142 'str-file|s=s' => \$str_file,
143 'exclude|x=s' => \@excludes,
144 'pedantic-warnings|pedantic' => sub { $pedantic_p = 1 },
147 VerboseWarnings::set_application_name $0;
148 VerboseWarnings::set_pedantic_mode $pedantic_p;
150 # try to make sure .po files are backed up (see BUGS)
151 $ENV{VERSION_CONTROL} = 't';
153 # keep the buggy Locale::PO quiet if it says stupid things
154 $SIG{__WARN__} = sub {
156 print STDERR $s unless $s =~ /^Strange line in [^:]+: #~/s
159 my $action = shift or usage_error('You must specify an ACTION.');
160 usage_error('You must at least specify input and string list filenames.')
161 if !@in_files || !defined $str_file;
163 # Type match defaults to *.tmpl plus *.inc if not specified
164 $type = "tmpl|inc" if !defined($type);
166 # Check the inputs for being files or directories
167 for my $input (@in_files) {
168 usage_error("$input: Input must be a file or directory.\n"
169 . "(Symbolic links are not supported at the moment)")
170 unless -d $input || -f $input;;
173 # Generates the global exclude regular expression
174 $exclude_regex = '(?:'.join('|', @excludes).')' if @excludes;
176 # Generate the list of input files if a directory is specified
177 if (-d $in_files[0]) {
178 die "If you specify a directory as input, you must specify only it.\n"
181 # input is a directory, generates list of files to process
182 $in_dir = $in_files[0];
183 $in_dir =~ s/\/$//; # strips the trailing / if any
184 @in_files = listfiles($in_dir, $type);
186 for my $input (@in_files) {
187 die "You cannot specify input files and directories at the same time.\n"
192 # restores the string list from file
193 $href = Locale::PO->load_file_ashash($str_file);
195 # guess the charsets. HTML::Templates defaults to iso-8859-1
197 $charset_out = TmplTokenizer::charset_canon $2
198 if $href->{'""'}->msgstr =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/;
199 for my $msgid (keys %$href) {
200 if ($msgid =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/) {
201 my $candidate = TmplTokenizer::charset_canon $2;
202 die "Conflicting charsets in msgid: $charset_in vs $candidate\n"
203 if defined $charset_in && $charset_in ne $candidate;
208 if (!defined $charset_in) {
209 $charset_in = TmplTokenizer::charset_canon 'iso8859-1';
210 warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n";
213 if ($action eq 'create') {
214 # updates the list. As the list is empty, every entry will be added
215 die "$str_file: Output file already exists" if -f $str_file;
216 my($tmph, $tmpfile) = tmpnam();
217 # Generate the temporary file that acts as <MODULE>/POTFILES.in
218 for my $input (@in_files) {
219 print $tmph "$input\n";
222 # Generate the specified po file ($str_file)
223 system ('xgettext.pl', '-s', '-f', $tmpfile, '-o', $str_file);
224 unlink $tmpfile || warn_normal "$tmpfile: unlink failed: $!\n", undef;
226 } elsif ($action eq 'update') {
227 my($tmph1, $tmpfile1) = tmpnam();
228 my($tmph2, $tmpfile2) = tmpnam();
229 close $tmph2; # We just want a name
230 # Generate the temporary file that acts as <MODULE>/POTFILES.in
231 for my $input (@in_files) {
232 print $tmph1 "$input\n";
235 # Generate the temporary file that acts as <MODULE>/<LANG>.pot
236 system('./xgettext.pl', '-s', '-f', $tmpfile1, '-o', $tmpfile2,
237 (defined $charset_in? ('-I', $charset_in): ()),
238 (defined $charset_out? ('-O', $charset_out): ()));
239 # Merge the temporary "pot file" with the specified po file ($str_file)
240 # FIXME: msgmerge(1) is a Unix dependency
241 # FIXME: need to check the return value
242 system('msgmerge', '-U', '-s', $str_file, $tmpfile2);
243 unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef;
244 unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef;
246 } elsif ($action eq 'install') {
247 if(!defined($out_dir)) {
248 usage_error("You must specify an output directory when using the install method.");
251 if ($in_dir eq $out_dir) {
252 warn "You must specify a different input and output directory.\n";
256 # Make sure the output directory exists
257 # (It will auto-create it, but for compatibility we should not)
258 -d $out_dir || die "$out_dir: The directory does not exist\n";
260 # Try to open the file, because Locale::PO doesn't check :-/
261 open(INPUT, "<$str_file") || die "$str_file: $!\n";
264 # creates the new tmpl file using the new translation
265 for my $input (@in_files) {
266 die "Assertion failed"
267 unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/";
269 my $h = TmplTokenizer->new( $input );
270 $h->set_allow_cformat( 1 );
271 VerboseWarnings::set_input_file_name $input;
273 my $target = $out_dir . substr($input, length($in_dir));
274 my $targetdir = $` if $target =~ /[^\/]+$/s;
275 if (!-d $targetdir) {
276 print STDERR "Making directory $targetdir...";
277 # creates with rwxrwxr-x permissions
278 mkdir($targetdir, 0775) || warn_normal "$targetdir: $!", undef;
280 print STDERR "Creating $target...\n";
281 open( OUTPUT, ">$target" ) || die "$target: $!\n";
282 text_replace( $h, *OUTPUT );
287 usage_error('Unknown action specified.');
291 ###############################################################################
295 ./tmpl_process3.pl [ I<tmpl_process.pl options> ]
299 This is an experimental version of the tmpl_process.pl script,
300 using standard gettext-style PO files.
302 Currently, the create, update, and install actions have all been
303 reimplemented and seem to work.
305 The create action calls xgettext.pl to do the actual work;
306 the update action calls xgettext.pl and msgmerge(1) to do the
309 The script can detect <TMPL_VAR> directives embedded inside what
310 appears to be a full sentence (this actual work being done by
311 TmplTokenizer(3)); these larger patterns appear in the translation
312 file as c-format strings with %s.
316 The --help option has not been implemented yet.
318 There are probably some real bugs too, since this has not been
321 xgettext.pl must be present in the current directory; the
322 msgmerge(1) command must also be present in the search path.
323 The script currently does not check carefully whether these
324 dependent commands are present.
326 If xgettext.pl is interrupted by the user, a corrupted po file
327 will result. This is very seriously wrong.
329 Locale::PO(3) has a lot of bugs. It can neither parse nor
330 generate GNU PO files properly; a couple of workarounds have
331 been written in TmplTokenizer and more is likely to be needed
332 (e.g., to get rid of the "Strange line" warning for #~).