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 return defined $href->{$key}
37 && !$href->{$key}->fuzzy
38 && length Locale::PO->dequote($href->{$key}->msgstr)?
39 Locale::PO->dequote($href->{$key}->msgstr): $s;
42 sub text_replace_tag ($$) {
45 # value [tag=input], meta
46 my $tag = lc($1) if $t =~ /^<(\S+)/s;
48 for my $a ('alt', 'content', 'title', 'value') {
50 next if $a eq 'content' && $tag ne 'meta';
51 next if $a eq 'value' && ($tag ne 'input'
52 || (ref $attr->{'type'} && $attr->{'type'}->[1] =~ /^(?:hidden|radio)$/)); # FIXME
53 my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
54 my($pre, $trimmed, $post) = TmplTokenizer::trim $val;
56 my $s = $pre . find_translation($trimmed) . $post;
57 if ($attr->{$a}->[1] ne $s) { #FIXME
58 $attr->{$a}->[1] = $s; # FIXME
59 $attr->{$a}->[2] = ($s =~ /"/s)? "'$s'": "\"$s\""; #FIXME
68 sprintf(' %s=%s', $_, $attr->{$_}->[2]) #FIXME
70 $attr->{$a}->[3] <=> $attr->{$b}->[3] #FIXME
79 sub text_replace (**) {
82 my $s = TmplTokenizer::next_token $h;
83 last unless defined $s;
84 my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
85 if ($kind eq TmplTokenType::TEXT) {
86 my($pre, $trimmed, $post) = TmplTokenizer::trim $t;
87 print $output $pre, find_translation($trimmed), $post;
88 } elsif ($kind eq TmplTokenType::TEXT_PARAMETRIZED) {
89 my $fmt = find_translation($s->form);
90 print $output TmplTokenizer::parametrize($fmt, map {
91 my($kind, $t, $attr) = ($_->type, $_->string, $_->attributes);
92 $kind == TmplTokenType::TAG && %$attr?
93 text_replace_tag($t, $attr): $t } $s->parameters);
94 } elsif ($kind eq TmplTokenType::TAG && %$attr) {
95 print $output text_replace_tag($t, $attr);
96 } elsif (defined $t) {
103 my($dir, $type) = @_;
105 if (opendir(DIR, $dir)) {
106 my @dirent = readdir DIR; # because DIR is shared when recursing
108 for my $dirent (@dirent) {
109 my $path = "$dir/$dirent";
110 if ($dirent =~ /^\./ || $dirent eq 'CVS' || $dirent eq 'RCS'
111 || (defined $exclude_regex && $dirent =~ /^(?:$exclude_regex)$/)) {
114 push @it, $path if !defined $type || $dirent =~ /\.(?:$type)$/;
115 } elsif (-d $path && $recursive_p) {
116 push @it, listfiles($path, $type);
120 warn_normal "$dir: $!", undef;
125 ###############################################################################
127 sub usage_error (;$) {
128 for my $msg (split(/\n/, $_[0])) {
129 print STDERR "$msg\n";
131 print STDERR "Try `$0 --help' for more information.\n";
135 ###############################################################################
138 'input|i=s' => \@in_files,
139 'outputdir|o=s' => \$out_dir,
140 'recursive|r' => \$recursive_p,
141 'str-file|s=s' => \$str_file,
142 'exclude|x=s' => \@excludes,
143 'pedantic-warnings|pedantic' => sub { $pedantic_p = 1 },
146 VerboseWarnings::set_application_name $0;
147 VerboseWarnings::set_pedantic_mode $pedantic_p;
149 # keep the buggy Locale::PO quiet if it says stupid things
150 $SIG{__WARN__} = sub {
152 print STDERR $s unless $s =~ /^Strange line in [^:]+: #~/s
155 my $action = shift or usage_error('You must specify an ACTION.');
156 usage_error('You must at least specify input and string list filenames.')
157 if !@in_files || !defined $str_file;
159 # Type match defaults to *.tmpl plus *.inc if not specified
160 $type = "tmpl|inc" if !defined($type);
162 # Check the inputs for being files or directories
163 for my $input (@in_files) {
164 usage_error("$input: Input must be a file or directory.\n"
165 . "(Symbolic links are not supported at the moment)")
166 unless -d $input || -f $input;;
169 # Generates the global exclude regular expression
170 $exclude_regex = '(?:'.join('|', @excludes).')' if @excludes;
172 # Generate the list of input files if a directory is specified
173 if (-d $in_files[0]) {
174 die "If you specify a directory as input, you must specify only it.\n"
177 # input is a directory, generates list of files to process
178 $in_dir = $in_files[0];
179 $in_dir =~ s/\/$//; # strips the trailing / if any
180 @in_files = listfiles($in_dir, $type);
182 for my $input (@in_files) {
183 die "You cannot specify input files and directories at the same time.\n"
188 # restores the string list from file
189 $href = Locale::PO->load_file_ashash($str_file);
191 # guess the charsets. HTML::Templates defaults to iso-8859-1
193 $charset_out = TmplTokenizer::charset_canon $2
194 if $href->{'""'}->msgstr =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/;
195 for my $msgid (keys %$href) {
196 if ($msgid =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/) {
197 my $candidate = TmplTokenizer::charset_canon $2;
198 die "Conflicting charsets in msgid: $charset_in vs $candidate\n"
199 if defined $charset_in && $charset_in ne $candidate;
204 if (!defined $charset_in) {
205 $charset_in = TmplTokenizer::charset_canon 'iso8859-1';
206 warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n";
209 if ($action eq 'create') {
210 # updates the list. As the list is empty, every entry will be added
211 die "$str_file: Output file already exists" if -f $str_file;
212 my($tmph, $tmpfile) = tmpnam();
213 # Generate the temporary file that acts as <MODULE>/POTFILES.in
214 for my $input (@in_files) {
215 print $tmph "$input\n";
218 # Generate the specified po file ($str_file)
219 system ('xgettext.pl', '-s', '-f', $tmpfile, '-o', $str_file);
220 unlink $tmpfile || warn_normal "$tmpfile: unlink failed: $!\n", undef;
222 } elsif ($action eq 'update') {
223 my($tmph1, $tmpfile1) = tmpnam();
224 my($tmph2, $tmpfile2) = tmpnam();
225 close $tmph2; # We just want a name
226 # Generate the temporary file that acts as <MODULE>/POTFILES.in
227 for my $input (@in_files) {
228 print $tmph1 "$input\n";
231 # Generate the temporary file that acts as <MODULE>/<LANG>.pot
232 system('./xgettext.pl', '-s', '-f', $tmpfile1, '-o', $tmpfile2,
233 (defined $charset_in? ('-I', $charset_in): ()),
234 (defined $charset_out? ('-O', $charset_out): ()));
235 # Merge the temporary "pot file" with the specified po file ($str_file)
236 # FIXME: msgmerge(1) is a Unix dependency
237 # FIXME: need to check the return value
238 system('msgmerge', '-U', '-s', $str_file, $tmpfile2);
239 unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef;
240 unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef;
242 } elsif ($action eq 'install') {
243 if(!defined($out_dir)) {
244 usage_error("You must specify an output directory when using the install method.");
247 if ($in_dir eq $out_dir) {
248 warn "You must specify a different input and output directory.\n";
252 # Make sure the output directory exists
253 # (It will auto-create it, but for compatibility we should not)
254 -d $out_dir || die "$out_dir: The directory does not exist\n";
256 # Try to open the file, because Locale::PO doesn't check :-/
257 open(INPUT, "<$str_file") || die "$str_file: $!\n";
260 # creates the new tmpl file using the new translation
261 for my $input (@in_files) {
262 die "Assertion failed"
263 unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/";
265 my $h = TmplTokenizer->new( $input );
266 $h->set_allow_cformat( 1 );
267 VerboseWarnings::set_input_file_name $input;
269 my $target = $out_dir . substr($input, length($in_dir));
270 my $targetdir = $` if $target =~ /[^\/]+$/s;
271 if (!-d $targetdir) {
272 print STDERR "Making directory $targetdir...";
273 # creates with rwxrwxr-x permissions
274 mkdir($targetdir, 0775) || warn_normal "$targetdir: $!", undef;
276 print STDERR "Creating $target...\n";
277 open( OUTPUT, ">$target" ) || die "$target: $!\n";
278 text_replace( $h, *OUTPUT );
283 usage_error('Unknown action specified.');
287 ###############################################################################
291 ./tmpl_process3.pl [ I<tmpl_process.pl options> ]
295 This is an experimental version of the tmpl_process.pl script,
296 using standard gettext-style PO files.
298 Currently, the create, update, and install actions have all been
299 reimplemented and seem to work.
301 The create action calls xgettext.pl to do the actual work;
302 the update action calls xgettext.pl and msgmerge(1) to do the
305 The script can detect <TMPL_VAR> directives embedded inside what
306 appears to be a full sentence (this actual work being done by
307 TmplTokenizer(3)); these larger patterns appear in the translation
308 file as c-format strings with %s.
312 The --help option has not been implemented yet.
314 There are probably some real bugs too, since this has not been
317 xgettext.pl must be present in the current directory; the
318 msgmerge(1) command must also be present in the search path.
319 The script currently does not check carefully whether these
320 dependent commands are present.
322 Locale::PO(3) has a lot of bugs. It can neither parse nor
323 generate GNU PO files properly; a couple of workarounds have
324 been written in TmplTokenizer and more is likely to be needed
325 (e.g., to get rid of the "Strange line" warning for #~).