Annotation of loncom/localize/localize/synch.pl, revision 1.13
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
1.12 bisitz 16: my $helper=0;
1.9 bisitz 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.13 ! bisitz 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'
1.11 bisitz 40: );
1.9 bisitz 41:
42: # ----------------------------------------------------------------
43: # ----- Sub Routines -----
1.3 www 44:
1.1 www 45: sub readlexicon {
1.11 bisitz 46: # Read translation file into memory
1.1 www 47: my $fn=shift;
1.11 bisitz 48: open(IN,$fn) or die;
1.1 www 49: my %lexicon=();
50: my $contents=join('',<IN>);
51: close(IN);
1.11 bisitz 52: # Tidy up: remove header data
1.1 www 53: $contents=~s/package Apache\:[^\;]+//;
54: $contents=~s/use base[^\;]+//;
1.11 bisitz 55: # Build hash with hash from file
56: my %Lexicon=();
1.1 www 57: eval($contents.'; %lexicon=%Lexicon;');
1.11 bisitz 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
1.1 www 64: delete $lexicon{'_AUTO'};
65: delete $lexicon{'char_encoding'};
66: delete $lexicon{'language_code'};
1.11 bisitz 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: }
1.1 www 72: return %lexicon;
73: }
74:
1.5 www 75: sub readnew {
1.11 bisitz 76: print "\n" if $debug;
77: open(IN,'newphrases.txt') or die;
1.9 bisitz 78: my %lexicon=();
1.5 www 79: while (my $line=<IN>) {
80: chomp($line);
81: $lexicon{$line}=$line;
1.11 bisitz 82: print " New entry: '$line'\n" if $debug;
1.5 www 83: }
84: close(IN);
85: return %lexicon;
86: }
87:
1.13 ! bisitz 88: sub takethisfile {
1.11 bisitz 89: my $file = shift;
1.13 ! bisitz 90: foreach my $listfile (@listoffiles) {
! 91: if ($listfile eq $file) { return 1 }
1.11 bisitz 92: }
93: return 0;
94: }
1.12 bisitz 95:
1.11 bisitz 96:
1.9 bisitz 97:
98: # ----------------------------------------------------------------
99: # ----- Main Program -----
100: my $i;
101: my $num;
102: my $dlm;
103: my $comment;
1.10 bisitz 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:
1.11 bisitz 110: # Initially fill master hash with phrases which are additionally needed/wanted.
1.10 bisitz 111: print " Adding new phrases... ";
112: my %master=&readnew();
1.11 bisitz 113: print scalar(keys(%master))." added... ";
1.10 bisitz 114: print "ok.\n";
1.11 bisitz 115:
1.10 bisitz 116: # Add all the different phrases of all translation files to master hash
1.2 www 117: foreach (<*.pm>) {
1.13 ! bisitz 118: if (&takethisfile($_)) {
! 119: print " Reading '".$_."'... ";
! 120: %master=(%master,&readlexicon($_));
! 121: print "ok.\n";
! 122: }
1.2 www 123: }
1.4 www 124:
1.10 bisitz 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... ";
1.11 bisitz 130: open(IN,'removephrases.txt') or die;
131: my $rm=0;
1.6 www 132: while (my $line=<IN>) {
133: chomp($line);
134: delete $master{$line};
1.11 bisitz 135: $rm++;
1.6 www 136: }
137: close(IN);
1.11 bisitz 138: print "$rm removed... ok.\n";
1.6 www 139:
140:
1.10 bisitz 141: print "Synchronization:\n";
1.12 bisitz 142: my $quotwarn=0;
1.4 www 143: foreach my $fn (<*.pm>) {
1.13 ! bisitz 144: if (!&takethisfile($fn)) { next }
1.11 bisitz 145: print " Synching '".$fn."'... ";
1.10 bisitz 146: # Build hash with all translations of current translation file
1.4 www 147: my %lang=&readlexicon($fn);
1.10 bisitz 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.
1.4 www 150: system ("cp $fn $fn.original");
1.11 bisitz 151: open(IN,$fn.'.original') or die;
1.10 bisitz 152: # Rebuild current translation file
153: # by writing all exisiting entries until SYNCMARKER
1.11 bisitz 154: open(OUT,'>'.$fn) or die;
1.2 www 155: my $found=0;
1.4 www 156: while (<IN>) {
1.12 bisitz 157: if ($_=~/\#\s*SYNCMARKER/) { $found=1; last; }
1.2 www 158: print OUT $_;
159: }
1.10 bisitz 160: # Append missing phrases to new version of current translation file
161: # by synching old version of current translation file with master hash
1.11 bisitz 162: if ($found) { # Only change files where SYNCMARKER was found
1.7 www 163: $i=0;
1.4 www 164: print OUT "\n\#SYNC ".localtime()."\n";
1.8 bisitz 165: # Sync master with current translation file:
1.5 www 166: foreach my $key (sort keys %master) {
1.11 bisitz 167: print "\n Checking key: '$key'" if $debug;
1.5 www 168: unless ($key) { next; }
169: unless ($lang{$key}) {
1.11 bisitz 170: # Translation helper?
1.9 bisitz 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: }
1.5 www 181: }
1.11 bisitz 182: # Numbered?
183: $i++;
1.7 www 184: if ($numbered) {
185: $num=' ('.$i.')';
186: } else {
187: $num='';
188: }
1.11 bisitz 189: # Find delimiter for key and value
1.12 bisitz 190: if (($key=~/\'/) & ($key=~/\"/)) {
191: $quotwarn++;
192: print " Warning: Both, ' and \",occur!" if $debug;
193: }
194: # if (($key=~/[^\\]\'/) | ($key=~/\\\"/)) {
1.7 www 195: if ($key=~/\'/) {
1.9 bisitz 196: $dlm='"';
1.7 www 197: } else {
1.9 bisitz 198: $dlm="'";
1.7 www 199: }
1.11 bisitz 200: # Write new entry to translation file
201: print OUT (<<ENDNEW);
1.9 bisitz 202: $dlm$key$dlm
203: => $dlm$key$num$dlm,
204: ENDNEW
1.11 bisitz 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
1.2 www 213: print OUT "\n\#SYNCMARKER\n";
214: foreach (<IN>) {
215: print OUT $_;
216: }
217: }
218: close (IN);
219: close (OUT);
1.11 bisitz 220: print "\n" if $debug;
221: print"$i added... ok.\n";
1.2 www 222: }
1.12 bisitz 223: if ($quotwarn) {
224: print "Warning: Issues expected due to occurrence of ' and \" in $quotwarn new key(s).\n";
225: }
1.10 bisitz 226: print "Synchronization completed.\n";
227:
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