Annotation of loncom/localize/localize/synch.pl, revision 1.11

1.9       bisitz      1: #!/usr/bin/perl
                      2: 
                      3: use strict;
                      4: use warnings;
                      5: 
                      6: # ----------------------------------------------------------------
                      7: # Configuration
                      8: 
1.11    ! bisitz      9: #  Add an ascending number after each new translation
1.9       bisitz     10: # 1: add, 0: don't add
                     11: my $numbered=0;
                     12: 
1.11    ! bisitz     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.
1.9       bisitz     15: # 1: add, 0: don't add
                     16: my $helper=0; 
                     17: 
1.10      bisitz     18: # Debug Mode
                     19: # Displays additional output for debugging purposes
1.11    ! bisitz     20: # WARNING: Creates a huge amount of output. Recommended to be used only for small test files.
        !            21: # 1: display, 0: don't display
1.10      bisitz     22: my $debug=0;
                     23: 
1.11    ! bisitz     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:    );
1.9       bisitz     30: 
                     31: # ----------------------------------------------------------------
                     32: # ----- Sub Routines -----
1.3       www        33: 
1.1       www        34: sub readlexicon {
1.11    ! bisitz     35:     # Read translation file into memory
1.1       www        36:     my $fn=shift;
1.11    ! bisitz     37:     open(IN,$fn) or die;
1.1       www        38:     my %lexicon=();
                     39:     my $contents=join('',<IN>);
                     40:     close(IN);
1.11    ! bisitz     41:     # Tidy up: remove header data
1.1       www        42:     $contents=~s/package Apache\:[^\;]+//;
                     43:     $contents=~s/use base[^\;]+//;
1.11    ! bisitz     44:     # Build hash with hash from file
        !            45:     my %Lexicon=();
1.1       www        46:     eval($contents.'; %lexicon=%Lexicon;');
1.11    ! bisitz     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
1.1       www        53:     delete $lexicon{'_AUTO'};
                     54:     delete $lexicon{'char_encoding'};
                     55:     delete $lexicon{'language_code'};
1.11    ! bisitz     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:     }
1.1       www        61:     return %lexicon;
                     62: }
                     63: 
1.5       www        64: sub readnew {
1.11    ! bisitz     65:     print "\n" if $debug;
        !            66:     open(IN,'newphrases.txt') or die;
1.9       bisitz     67:     my %lexicon=();
1.5       www        68:     while (my $line=<IN>) {
                     69: 	chomp($line);
                     70: 	$lexicon{$line}=$line;
1.11    ! bisitz     71:         print "    New entry: '$line'\n" if $debug;
1.5       www        72:     }
                     73:     close(IN);
                     74:     return %lexicon;
                     75: }
                     76: 
1.11    ! bisitz     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: 
1.9       bisitz     86: 
                     87: # ----------------------------------------------------------------
                     88: # ----- Main Program -----
                     89: my $i;
                     90: my $num;
                     91: my $dlm;
                     92: my $comment;
1.10      bisitz     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: 
1.11    ! bisitz     99: # Initially fill master hash with phrases which are additionally needed/wanted.
1.10      bisitz    100: print "  Adding new phrases... ";
                    101: my %master=&readnew();
1.11    ! bisitz    102: print scalar(keys(%master))." added... ";
1.10      bisitz    103: print "ok.\n";
1.11    ! bisitz    104: 
1.10      bisitz    105: # Add all the different phrases of all translation files to master hash
1.2       www       106: foreach (<*.pm>) {
1.11    ! bisitz    107:     if (&ignorefile($_)) { next }
        !           108:     print "  Reading '".$_."'... ";
1.2       www       109:     %master=(%master,&readlexicon($_));
1.10      bisitz    110:    print "ok.\n";
1.2       www       111: }
1.4       www       112: 
1.10      bisitz    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... ";
1.11    ! bisitz    118: open(IN,'removephrases.txt') or die;
        !           119: my $rm=0;
1.6       www       120: while (my $line=<IN>) {
                    121:     chomp($line);
                    122:     delete $master{$line};
1.11    ! bisitz    123:     $rm++;
1.6       www       124: }
                    125: close(IN);
1.11    ! bisitz    126: print "$rm removed... ok.\n";
1.6       www       127: 
                    128: 
1.10      bisitz    129: print "Synchronization:\n";
1.4       www       130: foreach my $fn (<*.pm>) {
1.11    ! bisitz    131:     if (&ignorefile($fn)) { next }
        !           132:     print "  Synching '".$fn."'... ";
1.10      bisitz    133:     # Build hash with all translations of current translation file
1.4       www       134:     my %lang=&readlexicon($fn);
1.10      bisitz    135:     # Copy current translation file so that the old file could be overwritten with the new content
                    136:     # while the copy is used to read from.
1.4       www       137:     system ("cp $fn $fn.original");
1.11    ! bisitz    138:     open(IN,$fn.'.original') or die;
1.10      bisitz    139:     # Rebuild current translation file
                    140:     # by writing all exisiting entries until SYNCMARKER
1.11    ! bisitz    141:     open(OUT,'>'.$fn) or die;
1.2       www       142:     my $found=0;
1.4       www       143:     while (<IN>) {
1.2       www       144: 	if ($_=~/\#\s*SYNCMARKER/) { $found=1; last; } 
                    145: 	print OUT $_;
                    146:     }
1.10      bisitz    147:     # Append missing phrases to new version of current translation file
                    148:     # by synching old version of current translation file with master hash
1.11    ! bisitz    149:     if ($found) { # Only change files where SYNCMARKER was found
1.7       www       150: 	$i=0;
1.4       www       151: 	print OUT "\n\#SYNC ".localtime()."\n";
1.8       bisitz    152:         # Sync master with current translation file:
1.5       www       153: 	foreach my $key (sort keys %master) {
1.11    ! bisitz    154: 	    print "\n    Checking key: '$key'" if $debug;
1.5       www       155: 	    unless ($key) { next; }
                    156: 	    unless ($lang{$key}) {
1.11    ! bisitz    157:                 # Translation helper?
1.9       bisitz    158:                 if ($helper) {
                    159: 		    $comment='';
                    160: 		    my $copytrans=$key;
                    161:                     # Create comment based on already existing translations:
                    162: 		    foreach (reverse sort keys %lang) {
                    163: 		        $copytrans=~s/\Q$_\E/$lang{$_}/gsi; # \Q \E: escape meta characters
                    164: 		    }
                    165: 		    if (lc($copytrans) ne lc($key)) {
                    166: 		        $comment='# '.$copytrans;
                    167:                     }
1.5       www       168:                 }
1.11    ! bisitz    169:                 # Numbered?
        !           170: 		$i++;
1.7       www       171: 		if ($numbered) {
                    172: 		    $num=' ('.$i.')';
                    173: 		} else {
                    174: 		    $num='';
                    175: 		}
1.11    ! bisitz    176:                 # Find delimiter for key and value
1.7       www       177: 		if ($key=~/\'/) {
1.9       bisitz    178: 		    $dlm='"';
1.7       www       179: 		} else {
1.9       bisitz    180: 		    $dlm="'";
1.7       www       181: 		}
1.11    ! bisitz    182:                 # Write new entry to translation file
        !           183:                 print OUT (<<ENDNEW);
1.9       bisitz    184:    $dlm$key$dlm
                    185: => $dlm$key$num$dlm,
                    186: ENDNEW
1.11    ! bisitz    187:                 if ($helper) {
        !           188:                     print OUT $comment
        !           189:                 }
        !           190:                 print OUT "\n";
        !           191: 		print " > added" if $debug;
        !           192:             }
        !           193:         }
        !           194:         # Add SYNCMARKER at end of file
1.2       www       195: 	print OUT "\n\#SYNCMARKER\n";
                    196: 	foreach (<IN>) {
                    197: 	    print OUT $_;
                    198: 	}
                    199:     }
                    200:     close (IN);
                    201:     close (OUT);
1.11    ! bisitz    202:     print "\n" if $debug;
        !           203:     print"$i added... ok.\n";
1.2       www       204: }
1.10      bisitz    205: print "Synchronization completed.\n";
                    206: 

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