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
30 ###############################################################################
32 sub find_translation ($) {
34 my $key = TmplTokenizer::quote_po($s) if $s =~ /\S/;
35 return defined $href->{$key}
36 && length Locale::PO->dequote($href->{$key}->msgstr)?
37 Locale::PO->dequote($href->{$key}->msgstr): $s;
40 sub text_replace_tag ($$) {
43 # value [tag=input], meta
44 my $tag = lc($1) if $t =~ /^<(\S+)/s;
46 for my $a ('alt', 'content', 'title', 'value') {
48 next if $a eq 'content' && $tag ne 'meta';
49 next if $a eq 'value' && ($tag ne 'input'
50 || (ref $attr->{'type'} && $attr->{'type'}->[1] =~ /^(?:hidden|radio)$/)); # FIXME
51 my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
52 my($pre, $trimmed, $post) = TmplTokenizer::trim $val;
54 my $s = $pre . find_translation($trimmed) . $post;
55 if ($attr->{$a}->[1] ne $s) { #FIXME
56 $attr->{$a}->[1] = $s; # FIXME
57 $attr->{$a}->[2] = ($s =~ /"/s)? "'$s'": "\"$s\""; #FIXME
66 sprintf(' %s=%s', $_, $attr->{$_}->[2]) #FIXME
68 $attr->{$a}->[3] <=> $attr->{$b}->[3] #FIXME
77 sub text_replace (**) {
80 my $s = TmplTokenizer::next_token $h;
81 last unless defined $s;
82 my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
83 if ($kind eq TmplTokenType::TEXT) {
84 my($pre, $trimmed, $post) = TmplTokenizer::trim $t;
85 print $output $pre, find_translation($trimmed), $post;
86 } elsif ($kind eq TmplTokenType::TEXT_PARAMETRIZED) {
87 my $fmt = find_translation($s->form);
88 print $output TmplTokenizer::parametrize($fmt, map {
89 my($kind, $t, $attr) = ($_->type, $_->string, $_->attributes);
90 $kind == TmplTokenType::TAG && %$attr?
91 text_replace_tag($t, $attr): $t } $s->parameters);
92 } elsif ($kind eq TmplTokenType::TAG && %$attr) {
93 print $output text_replace_tag($t, $attr);
94 } elsif (defined $t) {
100 # FIXME: Should we use the GNOME convention of using POTFILES.in instead?
102 my($dir, $type) = @_;
104 if (opendir(DIR, $dir)) {
105 my @dirent = readdir DIR; # because DIR is shared when recursing
107 for my $dirent (@dirent) {
108 my $path = "$dir/$dirent";
109 if ($dirent =~ /^\./ || $dirent eq 'CVS' || $dirent eq 'RCS'
110 || (defined $exclude_regex && $dirent =~ /^(?:$exclude_regex)$/)) {
113 push @it, $path if !defined $type || $dirent =~ /\.(?:$type)$/;
114 } elsif (-d $path && $recursive_p) {
115 push @it, listfiles($path, $type);
119 warn_normal "$dir: $!", undef;
124 ###############################################################################
126 sub usage_error (;$) {
127 for my $msg (split(/\n/, $_[0])) {
128 print STDERR "$msg\n";
130 print STDERR "Try `$0 --help' for more information.\n";
134 ###############################################################################
137 'input|i=s' => \@in_files,
138 'outputdir|o=s' => \$out_dir,
139 'recursive|r' => \$recursive_p,
140 'str-file|s=s' => \$str_file,
141 'exclude|x=s' => \@excludes,
142 'pedantic-warnings|pedantic' => sub { $pedantic_p = 1 },
145 VerboseWarnings::set_application_name $0;
146 VerboseWarnings::set_pedantic_mode $pedantic_p;
148 my $action = shift or usage_error('You must specify an ACTION.');
149 usage_error('You must at least specify input and string list filenames.')
150 if !@in_files || !defined $str_file;
152 # Type match defaults to *.tmpl plus *.inc if not specified
153 $type = "tmpl|inc" if !defined($type);
155 # Check the inputs for being files or directories
156 for my $input (@in_files) {
157 usage_error("$input: Input must be a file or directory.\n"
158 . "(Symbolic links are not supported at the moment)")
159 unless -d $input || -f $input;;
162 # Generates the global exclude regular expression
163 $exclude_regex = '(?:'.join('|', @excludes).')' if @excludes;
165 # Generate the list of input files if a directory is specified
166 if (-d $in_files[0]) {
167 die "If you specify a directory as input, you must specify only it.\n"
170 # input is a directory, generates list of files to process
171 $in_dir = $in_files[0];
172 $in_dir =~ s/\/$//; # strips the trailing / if any
173 @in_files = listfiles($in_dir, $type);
175 for my $input (@in_files) {
176 die "You cannot specify input files and directories at the same time.\n"
181 if ($action eq 'create') {
182 # updates the list. As the list is empty, every entry will be added
183 die "$str_file: Output file already exists" if -f $str_file;
184 my($tmph, $tmpfile) = tmpnam();
185 for my $input (@in_files) {
186 print $tmph "$input\n";
189 system {'./xgettext.pl'} ('xgettext.pl', '-s', '-f', $tmpfile, '-o', $str_file);
190 unlink $tmpfile || warn_normal "$tmpfile: unlink failed: $!\n", undef;
192 } elsif ($action eq 'update') {
193 my($tmph1, $tmpfile1) = tmpnam();
194 my($tmph2, $tmpfile2) = tmpnam();
195 close $tmph2; # We just want a name
196 for my $input (@in_files) {
197 print $tmph1 "$input\n";
200 system('./xgettext.pl', '-s', '-f', $tmpfile1, '-o', $tmpfile2);
201 system('msgmerge', '-U', '-s', $str_file, $tmpfile2);
202 unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef;
203 unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef;
205 } elsif ($action eq 'install') {
206 if(!defined($out_dir)) {
207 usage_error("You must specify an output directory when using the install method.");
210 if ($in_dir eq $out_dir) {
211 warn "You must specify a different input and output directory.\n";
215 # Make sure the output directory exists
216 # (It will auto-create it, but for compatibility we should not)
217 -d $out_dir || die "$out_dir: The directory does not exist\n";
219 # Try to open the file, because Locale::PO doesn't check :-/
220 open(INPUT, "<$str_file") || die "$str_file: $!\n";
223 # restores the string list from file
224 $href = Locale::PO->load_file_ashash($str_file);
226 # creates the new tmpl file using the new translation
227 for my $input (@in_files) {
228 die "Assertion failed"
229 unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/";
231 my $h = TmplTokenizer->new( $input );
232 $h->set_allow_cformat( 1 );
233 VerboseWarnings::set_input_file_name $input;
235 my $target = $out_dir . substr($input, length($in_dir));
236 my $targetdir = $` if $target =~ /[^\/]+$/s;
237 if (!-d $targetdir) {
238 print STDERR "Making directory $targetdir...";
239 # creates with rwxrwxr-x permissions
240 mkdir($targetdir, 0775) || warn_normal "$targetdir: $!", undef;
242 print STDERR "Creating $target...\n";
243 open( OUTPUT, ">$target" ) || die "$target: $!\n";
244 text_replace( $h, *OUTPUT );
249 usage_error('Unknown action specified.');
253 ###############################################################################
257 ./tmpl_process3.pl [ I<tmpl_process.pl options> ]
261 This is an experimental version of the tmpl_process.pl script,
262 using standard gettext-style PO files.
264 Currently, the create, update, and install actions have all been
265 reimplemented and seem to work.
267 The create action calls xgettext.pl to do the actual work;
268 the update action calls xgettext.pl and msgmerge(1) to do the
271 The script can detect <TMPL_VAR> directives embedded inside what
272 appears to be a full sentence (this actual work being done by
273 TmplTokenizer(3)); these larger patterns appear in the translation
274 file as c-format strings with %s.
278 The --help option has not been implemented yet.
280 There are probably some real bugs too, since this has not been
283 xgettext.pl must be present in the current directory; the
284 msgmerge(1) command must also be present in the search path.
285 The script currently does not check carefully whether these
286 dependent commands are present.
288 Locale::PO(3) has a lot of bugs. It can neither parse nor
289 generate GNU PO files properly; a couple of workarounds have
290 been written in TmplTokenizer and more is likely to be needed
291 (e.g., to get rid of the "Strange line" warning for #~).