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

1.9       bisitz      1: #!/usr/bin/perl
                      2: 
                      3: use strict;
                      4: use warnings;
                      5: 
                      6: # ----------------------------------------------------------------
                      7: # Configuration
                      8: 
                      9: #  Add a ascending number after each new translation
                     10: # 1: add, 0: don't add
                     11: my $numbered=0;
                     12: 
                     13: # Add a comment after each new translation.
                     14: # This comment contains a combination of translations which are build by using already existing translations.
                     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
        !            20: my $debug=0;
        !            21: 
1.9       bisitz     22: 
                     23: # ----------------------------------------------------------------
                     24: # ----- Sub Routines -----
1.3       www        25: 
1.1       www        26: sub readlexicon {
                     27:     my $fn=shift;
                     28:     open(IN,$fn);
                     29:     my %lexicon=();
                     30:     my $contents=join('',<IN>);
                     31:     close(IN);
                     32:     $contents=~s/package Apache\:[^\;]+//;
                     33:     $contents=~s/use base[^\;]+//;
                     34:     eval($contents.'; %lexicon=%Lexicon;');
                     35:     delete $lexicon{'_AUTO'};
                     36:     delete $lexicon{'char_encoding'};
                     37:     delete $lexicon{'language_code'};
                     38:     return %lexicon;
                     39: }
                     40: 
1.5       www        41: sub readnew {
                     42:     open(IN,'newphrases.txt');
1.9       bisitz     43:     my %lexicon=();
1.5       www        44:     while (my $line=<IN>) {
                     45: 	chomp($line);
                     46: 	$lexicon{$line}=$line;
1.10    ! bisitz     47:         print "    New entry: $line\n" if $debug;
1.5       www        48:     }
                     49:     close(IN);
                     50:     return %lexicon;
                     51: }
                     52: 
1.9       bisitz     53: 
                     54: # ----------------------------------------------------------------
                     55: # ----- Main Program -----
                     56: my $i;
                     57: my $num;
                     58: my $dlm;
                     59: my $comment;
1.10    ! bisitz     60: 
        !            61: print "*** Synching Translation Files ***\n";
        !            62: 
        !            63: # Create master hash for the entire set of all translations
        !            64: print "Building master hash:\n";
        !            65: 
        !            66: # Initialy fill master hash with phrases which are additionally needed/wanted.
        !            67: print "  Adding new phrases... ";
        !            68: my %master=&readnew();
        !            69: print "ok.\n";
1.9       bisitz     70:   
1.10    ! bisitz     71: # Add all the different phrases of all translation files to master hash
1.2       www        72: foreach (<*.pm>) {
1.10    ! bisitz     73:     print "  Reading ".$_." ... ";
1.2       www        74:     %master=(%master,&readlexicon($_));
1.10    ! bisitz     75:    print "ok.\n";
1.2       www        76: }
1.4       www        77: 
1.10    ! bisitz     78: # Ignore all phrases found in removephrases.txt for current synchronization.
        !            79: # These phrases would not be removed from a translation file, if they existed in the file.
        !            80: # But the phrases will not be added to any translation file even if they were missing in it.
        !            81: # Remove these obsolete phrases from master hash
        !            82: print "  Removing obsolete phrases... ";
1.6       www        83: open(IN,'removephrases.txt');
                     84: while (my $line=<IN>) {
                     85:     chomp($line);
                     86:     delete $master{$line};
                     87: }
                     88: close(IN);
1.10    ! bisitz     89: print "ok.\n";
1.6       www        90: 
                     91: 
1.10    ! bisitz     92: print "Synchronization:\n";
1.4       www        93: foreach my $fn (<*.pm>) {
1.10    ! bisitz     94:     print "  Synching ".$fn." ... ";
        !            95:     # Build hash with all translations of current translation file
1.4       www        96:     my %lang=&readlexicon($fn);
1.10    ! bisitz     97:     # Copy current translation file so that the old file could be overwritten with the new content
        !            98:     # while the copy is used to read from.
1.4       www        99:     system ("cp $fn $fn.original");
1.2       www       100:     open(IN,$fn.'.original');
1.10    ! bisitz    101:     # Rebuild current translation file
        !           102:     # by writing all exisiting entries until SYNCMARKER
1.2       www       103:     open(OUT,'>'.$fn);
                    104:     my $found=0;
1.4       www       105:     while (<IN>) {
1.2       www       106: 	if ($_=~/\#\s*SYNCMARKER/) { $found=1; last; } 
                    107: 	print OUT $_;
                    108:     }
1.10    ! bisitz    109:     # Append missing phrases to new version of current translation file
        !           110:     # by synching old version of current translation file with master hash
1.2       www       111:     if ($found) {
1.7       www       112: 	$i=0;
1.4       www       113: 	print OUT "\n\#SYNC ".localtime()."\n";
1.8       bisitz    114:         # Sync master with current translation file:
1.5       www       115: 	foreach my $key (sort keys %master) {
                    116: 	    unless ($key) { next; }
                    117: 	    unless ($lang{$key}) {
1.10    ! bisitz    118:                 print "    Found to be added: $key\n" if $debug;
1.9       bisitz    119:                 if ($helper) {
                    120: 		    $comment='';
                    121: 		    my $copytrans=$key;
                    122:                     # Create comment based on already existing translations:
                    123: 		    foreach (reverse sort keys %lang) {
                    124: 		        $copytrans=~s/\Q$_\E/$lang{$_}/gsi; # \Q \E: escape meta characters
                    125: 		    }
                    126: 		    if (lc($copytrans) ne lc($key)) {
                    127: 		        $comment='# '.$copytrans;
                    128:                     }
1.5       www       129:                 }
1.7       www       130: 		if ($numbered) {
                    131: 		    $i++;
                    132: 		    $num=' ('.$i.')';
                    133: 		} else {
                    134: 		    $num='';
                    135: 		}
                    136: 		if ($key=~/\'/) {
1.9       bisitz    137: 		    $dlm='"';
1.7       www       138: 		} else {
1.9       bisitz    139: 		    $dlm="'";
1.7       www       140: 		}
1.9       bisitz    141: 		if ($helper) {
                    142: 		    print OUT (<<ENDNEW);
                    143:    $dlm$key$dlm
                    144: => $dlm$key$num$dlm,
1.5       www       145: $comment
1.9       bisitz    146: 
1.4       www       147: ENDNEW
1.9       bisitz    148: 		} else {
                    149: 		    print OUT (<<ENDNEW);
                    150:    $dlm$key$dlm
                    151: => $dlm$key$num$dlm,
                    152: 
                    153: ENDNEW
                    154: 		}
1.4       www       155: 	    }
                    156: 	}
1.2       www       157: 
                    158: 	print OUT "\n\#SYNCMARKER\n";
                    159: 	foreach (<IN>) {
                    160: 	    print OUT $_;
                    161: 	}
                    162:     }
                    163:     close (IN);
                    164:     close (OUT);
1.10    ! bisitz    165:     print"ok.\n";
1.2       www       166: }
1.10    ! bisitz    167: print "Synchronization completed.\n";
        !           168: 

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