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