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