Return to synch.pl CVS log

Up to [LON-CAPA] / loncom / localize / localize

- Added warning and debug messages for new keys which contain both, ' and ".
- Removed two unneeded blanks at end of line

    1: #!/usr/bin/perl
    2: 
    3: use strict;
    4: use warnings;
    5: 
    6: # ----------------------------------------------------------------
    7: # Configuration
    8: 
    9: #  Add an ascending number after each new translation
   10: # 1: add, 0: don't add
   11: my $numbered=0;
   12: 
   13: # Add a translation help comment after each new translation.
   14: # This comment contains a combination of translations which are built by using already existing translations.
   15: # 1: add, 0: don't add
   16: my $helper=0;
   17: 
   18: # Debug Mode
   19: # Displays additional output for debugging purposes
   20: # WARNING: Creates a huge amount of output. Recommended to be used only for small test files.
   21: # 1: display, 0: don't display
   22: my $debug=0;
   23: 
   24: # List of files to be ignored when synching
   25: # These files don't contain actual translation phrases
   26: my @ignorefiles=(
   27:        "x_chef.pm"
   28:       ,"en.pm"
   29:    );
   30: 
   31: # ----------------------------------------------------------------
   32: # ----- Sub Routines -----
   33: 
   34: sub readlexicon {
   35:     # Read translation file into memory
   36:     my $fn=shift;
   37:     open(IN,$fn) or die;
   38:     my %lexicon=();
   39:     my $contents=join('',<IN>);
   40:     close(IN);
   41:     # Tidy up: remove header data
   42:     $contents=~s/package Apache\:[^\;]+//;
   43:     $contents=~s/use base[^\;]+//;
   44:     # Build hash with hash from file
   45:     my %Lexicon=();
   46:     eval($contents.'; %lexicon=%Lexicon;');
   47:     if ($@ ne "") {
   48:         print "\nAn error occurred during the attempt to retrieve the translation hash for the file '$fn'.\n"
   49:              ."Error: ".$@."\n";
   50:         die;
   51:     }
   52:     # Remove entries which are not needed for synch
   53:     delete $lexicon{'_AUTO'};
   54:     delete $lexicon{'char_encoding'};
   55:     delete $lexicon{'language_code'};
   56:     # Hash is expected not to be empty
   57:     print scalar(keys(%lexicon))." found... ";
   58:     if (!scalar(keys(%lexicon))) {
   59:         print "\nWarning: No translation phrases from '$fn'.\n";
   60:     }
   61:     return %lexicon;
   62: }
   63: 
   64: sub readnew {
   65:     print "\n" if $debug;
   66:     open(IN,'newphrases.txt') or die;
   67:     my %lexicon=();
   68:     while (my $line=<IN>) {
   69: 	chomp($line);
   70: 	$lexicon{$line}=$line;
   71:         print "    New entry: '$line'\n" if $debug;
   72:     }
   73:     close(IN);
   74:     return %lexicon;
   75: }
   76: 
   77: sub ignorefile {
   78:     my $file = shift;
   79:     foreach my $ignfile (@ignorefiles) {
   80:         if ($ignfile eq $file) { return 1 }
   81:     }
   82:     return 0;
   83: }
   84: 
   85: 
   86: 
   87: # ----------------------------------------------------------------
   88: # ----- Main Program -----
   89: my $i;
   90: my $num;
   91: my $dlm;
   92: my $comment;
   93: 
   94: print "*** Synching Translation Files ***\n";
   95: 
   96: # Create master hash for the entire set of all translations
   97: print "Building master hash:\n";
   98: 
   99: # Initially fill master hash with phrases which are additionally needed/wanted.
  100: print "  Adding new phrases... ";
  101: my %master=&readnew();
  102: print scalar(keys(%master))." added... ";
  103: print "ok.\n";
  104: 
  105: # Add all the different phrases of all translation files to master hash
  106: foreach (<*.pm>) {
  107:     if (&ignorefile($_)) { next }
  108:     print "  Reading '".$_."'... ";
  109:     %master=(%master,&readlexicon($_));
  110:    print "ok.\n";
  111: }
  112: 
  113: # Ignore all phrases found in removephrases.txt for current synchronization.
  114: # These phrases would not be removed from a translation file, if they existed in the file.
  115: # But the phrases will not be added to any translation file even if they were missing in it.
  116: # Remove these obsolete phrases from master hash
  117: print "  Removing obsolete phrases... ";
  118: open(IN,'removephrases.txt') or die;
  119: my $rm=0;
  120: while (my $line=<IN>) {
  121:     chomp($line);
  122:     delete $master{$line};
  123:     $rm++;
  124: }
  125: close(IN);
  126: print "$rm removed... ok.\n";
  127: 
  128: 
  129: print "Synchronization:\n";
  130: my $quotwarn=0;
  131: foreach my $fn (<*.pm>) {
  132:     if (&ignorefile($fn)) { next }
  133:     print "  Synching '".$fn."'... ";
  134:     # Build hash with all translations of current translation file
  135:     my %lang=&readlexicon($fn);
  136:     # Copy current translation file so that the old file could be overwritten with the new content
  137:     # while the copy is used to read from.
  138:     system ("cp $fn $fn.original");
  139:     open(IN,$fn.'.original') or die;
  140:     # Rebuild current translation file
  141:     # by writing all exisiting entries until SYNCMARKER
  142:     open(OUT,'>'.$fn) or die;
  143:     my $found=0;
  144:     while (<IN>) {
  145: 	if ($_=~/\#\s*SYNCMARKER/) { $found=1; last; }
  146: 	print OUT $_;
  147:     }
  148:     # Append missing phrases to new version of current translation file
  149:     # by synching old version of current translation file with master hash
  150:     if ($found) { # Only change files where SYNCMARKER was found
  151: 	$i=0;
  152: 	print OUT "\n\#SYNC ".localtime()."\n";
  153:         # Sync master with current translation file:
  154: 	foreach my $key (sort keys %master) {
  155: 	    print "\n    Checking key: '$key'" if $debug;
  156: 	    unless ($key) { next; }
  157: 	    unless ($lang{$key}) {
  158:                 # Translation helper?
  159:                 if ($helper) {
  160: 		    $comment='';
  161: 		    my $copytrans=$key;
  162:                     # Create comment based on already existing translations:
  163: 		    foreach (reverse sort keys %lang) {
  164: 		        $copytrans=~s/\Q$_\E/$lang{$_}/gsi; # \Q \E: escape meta characters
  165: 		    }
  166: 		    if (lc($copytrans) ne lc($key)) {
  167: 		        $comment='# '.$copytrans;
  168:                     }
  169:                 }
  170:                 # Numbered?
  171: 		$i++;
  172: 		if ($numbered) {
  173: 		    $num=' ('.$i.')';
  174: 		} else {
  175: 		    $num='';
  176: 		}
  177:                 # Find delimiter for key and value
  178: 		if (($key=~/\'/) & ($key=~/\"/)) {
  179: 		    $quotwarn++;
  180: 		    print " Warning: Both, ' and \",occur!" if $debug;
  181: 		}
  182: 		# if (($key=~/[^\\]\'/) | ($key=~/\\\"/)) {
  183: 		if ($key=~/\'/) {
  184: 		    $dlm='"';
  185: 		} else {
  186: 		    $dlm="'";
  187: 		}
  188:                 # Write new entry to translation file
  189:                 print OUT (<<ENDNEW);
  190:    $dlm$key$dlm
  191: => $dlm$key$num$dlm,
  192: ENDNEW
  193:                 if ($helper) {
  194:                     print OUT $comment
  195:                 }
  196:                 print OUT "\n";
  197: 		print " > added" if $debug;
  198:             }
  199:         }
  200:         # Add SYNCMARKER at end of file
  201: 	print OUT "\n\#SYNCMARKER\n";
  202: 	foreach (<IN>) {
  203: 	    print OUT $_;
  204: 	}
  205:     }
  206:     close (IN);
  207:     close (OUT);
  208:     print "\n" if $debug;
  209:     print"$i added... ok.\n";
  210: }
  211: if ($quotwarn) {
  212:     print "Warning: Issues expected due to occurrence of ' and \" in $quotwarn new key(s).\n";
  213: }
  214: print "Synchronization completed.\n";
  215: