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>