misc/translator/tmpl_process.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use Getopt::Long;
   5
   6 my (@in_files, $str_file, $split_char, $recursive, $type, $out_dir, $in_dir, @excludes, $filter);
   7 my $help;
   8 my $exclude_regex;
   9
  10 $split_char = ' ';
  11
  12 GetOptions(
  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,
  18         'type=s' => \$type,
  19         'exclude=s' => \@excludes,
  20         'sep=s' => \$split_char,
  21         'help'  => sub { help() },
  22 ) || usage();
  23
  24 # utiliser glob() pour tous les fichiers d'un repertoire
  25
  26 my $action = shift or usage();
  27 my %strhash = ();
  28
  29 # Checks for missing input and string list arguments
  30
  31 if( !@in_files || !defined($str_file) )
  32 {
  33         usage("You must at least specify input and string list filenames.");
  34 }
  35
  36 # Type match defaults to *.tmpl if not specified
  37 $type = "tmpl|inc" if !defined($type);
  38
  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]))
  42 {
  43         usage("Unknown input. Input must a file or a directory. (Symbolic links are not supported for the moment.)");
  44 }
  45 elsif( -d $in_files[0] )
  46 {
  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
  50
  51         print "Generating list of files to process...\n";
  52
  53         @in_files = ();
  54         @in_files = &listfiles(\@in_files, $in_dir, $type, $recursive);
  55
  56         if(scalar(@in_files) == 0)
  57         {
  58                 warn "Nothing to process in $in_dir matching *.$type.";
  59                 exit -1;
  60         }
  61 }
  62
  63 # Generates the global exclude regular expression
  64 $exclude_regex =  "(".join("|", @excludes).")" if @excludes;
  65
  66 if( $action eq "create" )
  67 {
  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");
  72 }
  73 elsif( $action eq "update" )
  74 {
  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);
  81 }
  82 elsif( $action eq "install" )
  83 {
  84         if(!defined($out_dir))
  85         {
  86                 usage("You must specify an output directory when using the install method.");
  87         }
  88
  89         if( $in_dir eq $out_dir )
  90         {
  91                 warn "You must specify a different input and output directory.\n";
  92                 exit -1;
  93         }
  94
  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);
  99 }
 100 else
 101 {
 102         usage("Unknown action specified.");
 103 }
 104
 105 exit 0;
 106
 107 ##########################################################
 108 # Creates the new template files in the output directory #
 109 ##########################################################
 110
 111 sub install_strhash
 112 {
 113         my($strhash, $in_files, $in_dir, $out_dir) = @_;
 114
 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)
 117
 118         my $starttime = time();
 119
 120         $out_dir =~ s/\/$//; # chops the trailing / if any.
 121         # Processes every entry found.
 122         foreach my $file (@{$in_files})
 123         {
 124                 if( !open($fh_in, "< $file") )
 125                 {
 126                         warn "Can't open $file : $!\n";
 127                         next;
 128                 }
 129
 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.
 133
 134                 if(!defined $in_dir)
 135                 {
 136                         # processing single files not an entire directory
 137                         $out_file = "$out_dir/$file";
 138                 }
 139                 else
 140                 {
 141                         $out_file =~ s/^$in_dir/$out_dir/;
 142                 }
 143
 144                 my $slash = rindex($out_file, "\/");
 145                 $tmp_dir = substr($out_file, 0, $slash); #gets the directory where the file will be saved
 146
 147                 # the file doesn't exist
 148                 if( !(-f $tmp_dir) && !(-l $tmp_dir) && !(-e $tmp_dir) )
 149                 {
 150                         if(!mkdir($tmp_dir,0775)) # creates with rwxrwxr-x permissions
 151                         {
 152                                 warn("Make directory $tmp_dir : $!");
 153                                 close($fh_in);
 154                                 exit(1);
 155                         }
 156                 }
 157                 elsif((-f $tmp_dir) || (-l $tmp_dir))
 158                 {
 159                         warn("Unable to create directory $tmp_dir.\n A file or symbolic link with the same name already exists.");
 160                         close($fh_in);
 161                         exit(1);
 162                 }
 163
 164                 # opens handle for output
 165                 if( !open($fh_out, "> $out_file_tmp") )
 166                 {
 167                         warn "Can''t write $out_file : $!\n";
 168                         close($fh_in);
 169                         next;
 170                 }
 171                 my $lines;
 172                 while(my $line = <$fh_in>)
 173                 {
 174                         $lines.=$line;
 175                 }
 176                 foreach my $text (sort  {length($b) <=> length($a) || uc($b) cmp uc($a) } keys %{$strhash})
 177                 {
 178                 # Test if the key has been translated
 179                 if( %{$strhash}->{$text} != 1)
 180                         {
 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" )
 200                                 {
 201                                         if (%{$strhash}->{$text} =~ "LIMITED")
 202                                         {
 203                                                 # changing text
 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;
 209                                         } else {
 210                                                 # changing text
 211                                                 $subst =~ s/UNUSED;//;
 212                                                 $lines =~ s/(\W)$text(\W)/$1$subst$2/g;
 213                                         }
 214                                 }
 215                         }
 216                 }
 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);
 221                 close($fh_in);
 222                 close($fh_out);
 223                 # check if fh_out and previous fh_out has changed or not.
 224                 my $diff;
 225                 if(-f $out_file)  {
 226                         $diff = `diff $out_file $out_file_tmp`;
 227                 } else {
 228                         $diff = "write it, it's new";
 229                 }
 230                 if ($diff) {
 231                         print "WRITING : $out_file\n";
 232                         unlink $out_file;
 233                         system("mv $out_file_tmp $out_file");
 234                 } else {
 235                         print "no changes in $out_file\n";
 236                         unlink $out_file_tmp;
 237                 }
 238         }
 239         my $timeneeded = time() - $starttime;
 240         print "done in $timeneeded seconds\n";
 241
 242 }
 243
 244 ########################################################
 245 # Updates the string list hash with the new components #
 246 ########################################################
 247
 248 sub update_strhash
 249 {
 250         my($strhash, $in_files, $exclude, $filter)= @_;
 251
 252         my $fh;
 253
 254         # Processes every file entries
 255         foreach my $in (@{$in_files})
 256         {
 257
 258                 print "Processing $in...\n";
 259
 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;
 264
 265                 # Processes every string returned
 266                 while(my $str = <$fh>)
 267                 {
 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\*:\[*\(|\.,\)]*$//;
 271
 272                         # the line begins with letter(s) followed by optional words and/or spaces
 273                         if($str =~ /^[ ]*[\w]+[ \w]*/)
 274                         {
 275                                 # the line is to be excluded ?
 276                                 if( !(defined($exclude) && ($str =~ /$exclude/o) && $str>0) )
 277                                 {
 278                                         if( !defined(%{$strhash}->{$str}) )
 279                                         {
 280                                                 # the line is not already in the list so add it
 281                                                 %{$strhash}->{$str}=1;
 282                                         } else {
 283                                                 # remove UNUSED;
 284                                                 %{$strhash}->{$str} =~ s/^UNUSED;//;
 285                                         }
 286                                 }
 287                         }
 288                 }
 289
 290                 close($fh);
 291         }
 292
 293         return %{$strhash};
 294 }
 295
 296 #####################################################
 297 # Reads the input file and returns a generated hash #
 298 #####################################################
 299
 300 sub restore_strhash
 301 {
 302         my($strhash, $str_file, $split_char, $detect_unused) = @_;
 303
 304         my $fh;
 305
 306         open($fh, "< $str_file") or die "$str_file : $!";
 307
 308         print "Restoring string list from $str_file...\n";
 309
 310         while( my $line = <$fh> )
 311         {
 312                 chomp $line;
 313
 314                 # extracts the two fields
 315                 my ($original, $translated) = split(/$split_char/, $line, 2);
 316
 317                 if($translated ne "*****")
 318                 {
 319                         # the key has been translated
 320                         %{$strhash}->{$original} = $translated;
 321                 }
 322                 else
 323                 {
 324                         # the key exist but has no translation.
 325                         %{$strhash}->{$original} = 1;
 326                 }
 327                 if ($detect_unused) {
 328                         %{$strhash}->{$original} = "UNUSED;".%{$strhash}->{$original} unless %{$strhash}->{$original}=~ /^UNUSED;/;
 329                 }
 330
 331         }
 332
 333         close($fh);
 334
 335         return %{$strhash};
 336 }
 337
 338 #########################################
 339 # Writes the string hashtable to a file #
 340 #########################################
 341
 342 sub write_strhash
 343 {
 344         my($strhash, $str_file, $split_char) = @_;
 345
 346         my $fh;
 347
 348         # Opens a handle for saving the list
 349         open($fh, "> $str_file") or die "$str_file : $!";
 350
 351         print "Writing string list to $str_file...\n";
 352
 353         foreach my $str(sort {uc($a) cmp uc($b) || length($b) <=> length($a)} keys %{$strhash})
 354         {
 355                 if(%{$strhash}->{$str}!=1)
 356                 {
 357                         printf($fh "%s%s%s\n", $str, $split_char, %{$strhash}->{$str});
 358                 }
 359                 else
 360                 {
 361                         printf($fh "%s%s%s\n", $str, $split_char,"*****") unless ($str >0 || length($str) eq 1);
 362                 }
 363         }
 364
 365         close($fh);
 366 }
 367
 368 ########################################################
 369 # List the contents of dir matching the pattern *.type #
 370 ########################################################
 371
 372 sub listfiles
 373 {
 374         my($in_files, $dir, $type, $recursive) = @_;
 375
 376         my $dir_h;
 377 #       my @types = split(/ /,$type);
 378         opendir($dir_h, $dir) or warn("Can't open $dir : $!\n");
 379
 380         my @tmp_list = grep(!/^\.\.?$/, readdir($dir_h));
 381
 382         closedir($dir_h);
 383
 384         foreach my $tmp_file (@tmp_list)
 385         {
 386
 387                 if( $recursive && (-d "$dir/$tmp_file") ) # entry is a directory
 388                 {
 389                         @{$in_files} = listfiles($in_files, "$dir/$tmp_file", $type);
 390                 }
 391                 elsif( $tmp_file =~ /\.$type$/ )
 392                 {
 393                         push(@{$in_files}, "$dir/$tmp_file");
 394                 }
 395         }
 396         return @{$in_files};
 397 }
 398
 399 ######################################
 400 # DEBUG ROUTINE                      #
 401 # Prints the contents of a hashtable #
 402 ######################################
 403
 404 sub print_strhash
 405 {
 406         my($strhash, $split_char) = @_;
 407
 408         foreach my $str(sort keys %{$strhash})
 409         {
 410                 if(%{$strhash}->{$str} != 1)
 411                 {
 412                         printf("%s%s%s\n", $str, $split_char, %{$strhash}->{$str});
 413                 }
 414                 else
 415                 {
 416                         printf("%s%s\n", $str, $split_char);
 417                 }
 418         }
 419 }
 420
 421 #########################################
 422 # Short help messsage printing function #
 423 #########################################
 424
 425 sub usage
 426 {
 427         warn join(" ", @_)."\n" if @_;
 428         warn <<EOF;
 429
 430 Usage : $0 method -i input.tmpl|/input/dir -s strlist.file
 431         [-o /output/dir] [options]
 432
 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).
 439
 440 Use $0 --help for a complete listing of options.
 441 EOF
 442         exit(1);
 443 }
 444
 445 ##############################################
 446 # Long help message describing every options #
 447 ##############################################
 448
 449 sub help
 450 {
 451         warn <<EOF;
 452 Usage : $0 method [options]
 453
 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).
 460
 461 options can be :
 462
 463   -i or --input=
 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
 466      processed.
 467      When using files, the parameter can be repeated to process a list
 468      of files.
 469
 470   Example: $0 create -i foo.tmpl --input=bar.tmpl -s foobar.txt
 471
 472   -s or --str-file=
 473      Specify the file where the different strings will be stored.
 474
 475   -o or --outputdir=
 476      Specify the output directory to use when generating the translated
 477      input files.
 478
 479   -r or --recursive
 480      Use the recursive mode to process every entry in subdirectories.
 481      Note: Symbolic links used to link directories are not supported.
 482
 483   --type=
 484      Defines the type of files to match when input is a directory.
 485      By default --type=tmpl
 486
 487   --exclude=regex
 488      Use this option to exclude some entries extracted by the program.
 489      This option can be repeated to exclude many types of strings.
 490
 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
 494    be escaped.
 495
 496   --filter=
 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
 499      in order to use it.
 500
 501   --sep=char
 502      Use this option to specify the char to be used to separate entries
 503      in the string list file.
 504
 505   --help
 506      This help message.
 507 EOF
 508         exit(0);
 509 }
 510