File:  [LON-CAPA] / loncom / localize / localize / synch.pl
Revision 1.13: download - view: text, annotated - select for diffs
Wed Jun 3 16:33:15 2009 UTC (15 years, 1 month ago) by bisitz
Branches: MAIN
CVS tags: version_2_9_X, version_2_9_1, version_2_9_0, version_2_8_99_1, version_2_8_99_0, bz5969, bz2851, HEAD, GCI_3, GCI_2, BZ5971-printing-apage
Changed list of processed files from blacklist to whitelist:
Only synchronize translation files which are included in the list.

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>