6 my (@in_files, $str_file, $split_char, $recursive, $type, $out_dir, $in_dir, @excludes, $filter);
13 'input|i=s' => \@in_files,
14 'outputdir|o=s' => \$out_dir,
15 'str-file|s=s' => \$str_file,
16 'recursive|r' => \$recursive,
17 'filter=s' => \$filter,
19 'exclude=s' => \@excludes,
20 'sep=s' => \$split_char,
21 'help' => sub { help() },
24 # utiliser glob() pour tous les fichiers d'un repertoire
26 my $action = shift or usage();
29 # Checks for missing input and string list arguments
31 if( !@in_files || !defined($str_file) )
33 usage("You must at least specify input and string list filenames.");
36 # Type match defaults to *.tmpl if not specified
37 $type = "tmpl|inc" if !defined($type);
39 $filter = "./text-extract.pl -f" if !defined($filter);
40 # Input is not a file nor a directory
41 if( !(-d $in_files[0]) && !(-f $in_files[0]))
43 usage("Unknown input. Input must a file or a directory. (Symbolic links are not supported for the moment.)");
45 elsif( -d $in_files[0] )
47 # input is a directory, generates list of files to process
48 $in_dir = $in_files[0];
49 $in_dir =~ s/\/$//; # strips the trailing / if any
51 print "Generating list of files to process...\n";
54 @in_files = &listfiles(\@in_files, $in_dir, $type, $recursive);
56 if(scalar(@in_files) == 0)
58 warn "Nothing to process in $in_dir matching *.$type.";
63 # Generates the global exclude regular expression
64 $exclude_regex = "(".join("|", @excludes).")" if @excludes;
66 if( $action eq "create" )
68 # updates the list. As the list is empty, every entry will be added
69 %strhash = &update_strhash(\%strhash, \@in_files, $exclude_regex, $filter);
70 # saves the list to the file
71 write_strhash(\%strhash, $str_file, "\t");
73 elsif( $action eq "update" )
75 # restores the string list from file
76 %strhash = &restore_strhash(\%strhash, $str_file, $split_char,1);
77 # updates the list, adding new entries if any
78 %strhash = &update_strhash(\%strhash, \@in_files, $exclude_regex, $filter);
79 # saves the list to the file
80 write_strhash(\%strhash, $str_file, $split_char);
82 elsif( $action eq "install" )
84 if(!defined($out_dir))
86 usage("You must specify an output directory when using the install method.");
89 if( $in_dir eq $out_dir )
91 warn "You must specify a different input and output directory.\n";
95 # restores the string list from file
96 %strhash = &restore_strhash(\%strhash, $str_file, $split_char,0);
97 # creates the new tmpl file using the new translation
98 &install_strhash(\%strhash, \@in_files, $in_dir, $out_dir);
102 usage("Unknown action specified.");
107 ##########################################################
108 # Creates the new template files in the output directory #
109 ##########################################################
113 my($strhash, $in_files, $in_dir, $out_dir) = @_;
115 my $fh_in; my $fh_out; # handles for input and output files
116 my $tmp_dir; # temporary directory name (used to create destination dir)
118 my $starttime = time();
120 $out_dir =~ s/\/$//; # chops the trailing / if any.
121 # Processes every entry found.
122 foreach my $file (@{$in_files})
124 if( !open($fh_in, "< $file") )
126 warn "Can't open $file : $!\n";
130 # generates the name of the output file
131 my $out_file = $file;
132 my $out_file_tmp = $file.".tmp"; # used to check if file has changed or not.
136 # processing single files not an entire directory
137 $out_file = "$out_dir/$file";
141 $out_file =~ s/^$in_dir/$out_dir/;
144 my $slash = rindex($out_file, "\/");
145 $tmp_dir = substr($out_file, 0, $slash); #gets the directory where the file will be saved
147 # the file doesn't exist
148 if( !(-f $tmp_dir) && !(-l $tmp_dir) && !(-e $tmp_dir) )
150 if(!mkdir($tmp_dir,0775)) # creates with rwxrwxr-x permissions
152 warn("Make directory $tmp_dir : $!");
157 elsif((-f $tmp_dir) || (-l $tmp_dir))
159 warn("Unable to create directory $tmp_dir.\n A file or symbolic link with the same name already exists.");
164 # opens handle for output
165 if( !open($fh_out, "> $out_file_tmp") )
167 warn "Can''t write $out_file : $!\n";
172 while(my $line = <$fh_in>)
176 foreach my $text (sort {length($b) <=> length($a) || uc($b) cmp uc($a) } keys %{$strhash})
178 # Test if the key has been translated
179 if( %{$strhash}->{$text} != 1)
181 # Does the file contains text that needs to be changed ?
182 # escaping \|()[{}^$*+?.
183 my $subst = %{$strhash}->{$text};
184 $text =~ s/\\/\\\\/g;
185 $text =~ s/\//\\\//g;
186 $text =~ s/\|/\\\|/g;
187 $text =~ s/\(/\\\(/g;
188 $text =~ s/\)/\\\)/g;
189 $text =~ s/\[/\\\[/g;
190 $text =~ s/\]/\\\]/g;
191 $text =~ s/\{/\\\{/g;
192 $text =~ s/\}/\\\}/g;
193 $text =~ s/\^/\\\^/g;
194 $text =~ s/\$/\\\$/g;
195 $text =~ s/\*/\\\*/g;
196 $text =~ s/\+/\\\+/g;
197 $text =~ s/\?/\\\?/g;
198 $text =~ s/\./\\\./g;
199 if(%{$strhash}->{$text} ne "IGNORE" )
201 if (%{$strhash}->{$text} =~ "LIMITED")
204 $subst =~ s/UNUSED;//;
205 $subst =~ s/^LIMITED;//g;
206 $lines =~ s/(.*)>$text(\W)/$1>$subst$2/g;
207 $lines =~ s/(.*) title="$text/$1 title="$subst/g;
208 $lines =~ s/(.*) alt="$text/$1 alt="$subst/g;
211 $subst =~ s/UNUSED;//;
212 $lines =~ s/(\W)$text(\W)/$1$subst$2/g;
217 $lines =~ s/\<TMPL_(.*?)\>/\<\!-- TMPL_$1 --\>/g;
218 $lines =~ s/\<\/TMPL_(.*?)\>/\<\!-- \/TMPL_$1 --\>/g;
219 # Writing the modified (or not) file to output
220 printf($fh_out "%s", $lines);
223 # check if fh_out and previous fh_out has changed or not.
226 $diff = `diff $out_file $out_file_tmp`;
228 $diff = "write it, it's new";#'
231 print "WRITING : $out_file\n";
233 system("mv $out_file_tmp $out_file");
235 print "no changes in $out_file\n";
236 unlink $out_file_tmp;
239 my $timeneeded = time() - $starttime;
240 print "done in $timeneeded seconds\n";
244 ########################################################
245 # Updates the string list hash with the new components #
246 ########################################################
250 my($strhash, $in_files, $exclude, $filter)= @_;
254 # Processes every file entries
255 foreach my $in (@{$in_files})
258 print "Processing $in...\n";
260 # 'Creates a filehandle containing all the strings returned by
261 # the plain text program extractor
262 open($fh, "$filter $in |") or print "$filter $in : $!";
263 next $in if !defined $fh;
265 # Processes every string returned
266 while(my $str = <$fh>)
268 $str =~ s/[\n\r\f]+$//; # chomps the trailing \n (or <cr><lf> if file was edited with Windows)
269 $str =~ s/^[\s+:\(]*//; # remove useless characters
270 $str =~ s/[\s\*:\[*\(|\.,\)]*$//;#]
272 # the line begins with letter(s) followed by optional words and/or spaces
273 if($str =~ /^[ ]*[\w]+[ \w]*/)
275 # the line is to be excluded ?
276 if( !(defined($exclude) && ($str =~ /$exclude/o) && $str>0) )
278 if( !defined(%{$strhash}->{$str}) )
280 # the line is not already in the list so add it
281 %{$strhash}->{$str}=1;
284 %{$strhash}->{$str} =~ s/^UNUSED;//;
296 #####################################################
297 # Reads the input file and returns a generated hash #
298 #####################################################
302 my($strhash, $str_file, $split_char, $detect_unused) = @_;
306 open($fh, "< $str_file") or die "$str_file : $!";
308 print "Restoring string list from $str_file...\n";
310 while( my $line = <$fh> )
314 # extracts the two fields
315 my ($original, $translated) = split(/$split_char/, $line, 2);
317 if($translated ne "*****")
319 # the key has been translated
320 %{$strhash}->{$original} = $translated;
324 # the key exist but has no translation.
325 %{$strhash}->{$original} = 1;
327 if ($detect_unused) {
328 %{$strhash}->{$original} = "UNUSED;".%{$strhash}->{$original} unless %{$strhash}->{$original}=~ /^UNUSED;/;
338 #########################################
339 # Writes the string hashtable to a file #
340 #########################################
344 my($strhash, $str_file, $split_char) = @_;
348 # Opens a handle for saving the list
349 open($fh, "> $str_file") or die "$str_file : $!";
351 print "Writing string list to $str_file...\n";
353 foreach my $str(sort {uc($a) cmp uc($b) || length($b) <=> length($a)} keys %{$strhash})
355 if(%{$strhash}->{$str}!=1)
357 printf($fh "%s%s%s\n", $str, $split_char, %{$strhash}->{$str});
361 printf($fh "%s%s%s\n", $str, $split_char,"*****") unless ($str >0 || length($str) eq 1);
368 ########################################################
369 # List the contents of dir matching the pattern *.type #
370 ########################################################
374 my($in_files, $dir, $type, $recursive) = @_;
377 # my @types = split(/ /,$type);
378 opendir($dir_h, $dir) or warn("Can't open $dir : $!\n");
380 my @tmp_list = grep(!/^\.\.?$/, readdir($dir_h));
384 foreach my $tmp_file (@tmp_list)
387 if( $recursive && (-d "$dir/$tmp_file") ) # entry is a directory
389 @{$in_files} = listfiles($in_files, "$dir/$tmp_file", $type);
391 elsif( $tmp_file =~ /\.$type$/ && !($tmp_file =~ /^\./))
393 push(@{$in_files}, "$dir/$tmp_file");
399 ######################################
401 # Prints the contents of a hashtable #
402 ######################################
406 my($strhash, $split_char) = @_;
408 foreach my $str(sort keys %{$strhash})
410 if(%{$strhash}->{$str} != 1)
412 printf("%s%s%s\n", $str, $split_char, %{$strhash}->{$str});
416 printf("%s%s\n", $str, $split_char);
421 #########################################
422 # Short help messsage printing function #
423 #########################################
427 warn join(" ", @_)."\n" if @_;
430 Usage : $0 method -i input.tmpl|/input/dir -s strlist.file
431 [-o /output/dir] [options]
433 where method can be :
434 * create : creates the string list from scratch using the input files.
435 * update : updates an existing string list, adding the new strings to
436 the list, leaving the others alone.
437 * install : creates the new .tmpl files using the string list config file
438 (--outputdir must be used to specify the output directory).
440 Use $0 --help for a complete listing of options.
445 ##############################################
446 # Long help message describing every options #
447 ##############################################
452 Usage : $0 method [options]
454 where method can be :
455 * create : creates the string list from scratch using the input files.
456 * update : updates an existing string list, adding the new strings to
457 the list, leaving the others alone.
458 * install : creates the new .tmpl files using the string list config file
459 (-o must be used to specify the output directory).
464 Specify the input to process. Input can be a file or a directory.
465 When input is a directory, files matching the --type option will be
467 When using files, the parameter can be repeated to process a list
470 Example: $0 create -i foo.tmpl --input=bar.tmpl -s foobar.txt
473 Specify the file where the different strings will be stored.
476 Specify the output directory to use when generating the translated
480 Use the recursive mode to process every entry in subdirectories.
481 Note: Symbolic links used to link directories are not supported.
484 Defines the type of files to match when input is a directory.
485 By default --type=tmpl
488 Use this option to exclude some entries extracted by the program.
489 This option can be repeated to exclude many types of strings.
491 Example: $0 create -i foo.tmpl -s foo.txt --exclude=^\[0-9\]+\$
492 will create a list from foo.tmpl called foo.txt where lines
493 composed of numbers only are excluded. Special characters need to
497 Specify the program to use to extract plain text from files.
498 Default is str-extract which means str-extract must be in the path
502 Use this option to specify the char to be used to separate entries
503 in the string list file.