File:
[LON-CAPA] /
loncom /
localize /
localize /
synch.pl
Revision
1.15:
download - view:
text,
annotated -
select for diffs
Fri Dec 20 12:29:06 2013 UTC (10 years, 9 months ago) by
bisitz
Branches:
MAIN
CVS tags:
version_2_12_X,
version_2_11_X,
version_2_11_5_msu,
version_2_11_5,
version_2_11_4_uiuc,
version_2_11_4_msu,
version_2_11_4,
version_2_11_3_uiuc,
version_2_11_3_msu,
version_2_11_3,
version_2_11_2_uiuc,
version_2_11_2_msu,
version_2_11_2_educog,
version_2_11_2,
version_2_11_1,
version_2_11_0_RC3,
version_2_11_0,
HEAD
Add CVS header
#!/usr/bin/perl
# The LearningOnline Network with CAPA
# $Id: synch.pl,v 1.15 2013/12/20 12:29:06 bisitz Exp $
use strict;
use warnings;
# ----------------------------------------------------------------
# Configuration
# Add an ascending number after each new translation
# 1: add, 0: don't add
my $numbered=0;
# Add a translation help comment after each new translation.
# This comment contains a combination of translations which are built by using already existing translations.
# 1: add, 0: don't add
my $helper=0;
# Debug Mode
# Displays additional output for debugging purposes
# WARNING: Creates a huge amount of output. Recommended to be used only for small test files.
# 1: display, 0: don't display
my $debug=0;
# List of files to be accepted as translation files for synching
# These files contain actual translation phrases.
# If you want to exclude translation files from being included
# in the synching process, remove their file names from this list.
my @listoffiles=(
# 'test.pm'
,'ar.pm'
,'de.pm'
,'es.pm'
,'fa.pm'
,'fr.pm'
,'he.pm'
,'ja.pm'
,'pt.pm'
,'ru.pm'
,'tr.pm'
,'zh.pm'
);
# ----------------------------------------------------------------
# ----- Sub Routines -----
sub readlexicon {
# Read translation file into memory
my $fn=shift;
open(IN,$fn) or die;
my %lexicon=();
my $contents=join('',<IN>);
close(IN);
# Tidy up: remove header data
$contents=~s/package Apache\:[^\;]+//;
$contents=~s/use base[^\;]+//;
# Build hash with hash from file
my %Lexicon=();
eval($contents.'; %lexicon=%Lexicon;');
if ($@ ne "") {
print "\nAn error occurred during the attempt to retrieve the translation hash for the file '$fn'.\n"
."Error: ".$@."\n";
die;
}
# Remove entries which are not needed for synch
delete $lexicon{'_AUTO'};
delete $lexicon{'char_encoding'};
delete $lexicon{'language_code'};
# Hash is expected not to be empty
print scalar(keys(%lexicon))." found... ";
if (!scalar(keys(%lexicon))) {
print "\nWarning: No translation phrases from '$fn'.\n";
}
return %lexicon;
}
sub readnew {
print "\n" if $debug;
open(IN,'newphrases.txt') or die;
my %lexicon=();
while (my $line=<IN>) {
chomp($line);
next if ($line eq '');
$lexicon{$line}=$line;
print " New entry: '$line'\n" if $debug;
}
close(IN);
return %lexicon;
}
sub takethisfile {
my $file = shift;
foreach my $listfile (@listoffiles) {
if ($listfile eq $file) { return 1 }
}
return 0;
}
# ----------------------------------------------------------------
# ----- Main Program -----
my $i; # Count new phrases
my $num;
my $dlm; # Delimiter character
my $comment;
print "*** Synching Translation Files ***\n";
# Create master hash for the entire set of all translations
print "Building master hash:\n";
# Initially fill master hash with phrases which are additionally needed/wanted.
print " Adding new phrases... ";
my %master=&readnew();
print scalar(keys(%master))." added... ";
print "ok.\n";
# Add all the different phrases of all translation files to master hash
foreach (<*.pm>) {
if (&takethisfile($_)) {
print " Reading '".$_."'... ";
%master=(%master,&readlexicon($_));
print "ok.\n";
}
}
# Ignore all phrases found in removephrases.txt for current synchronization.
# These phrases would not be removed from a translation file, if they existed in the file.
# But the phrases will not be added to any translation file even if they were missing in it.
# Remove these obsolete phrases from master hash
print " Removing obsolete phrases... ";
open(IN,'removephrases.txt') or die;
my $rm=0;
while (my $line=<IN>) {
chomp($line);
next if ($line eq '');
delete $master{$line};
$rm++;
}
close(IN);
print "$rm removed... ok.\n";
print "Synchronization:\n";
my $quotwarn=0;
foreach my $fn (<*.pm>) {
if (!&takethisfile($fn)) { next }
print " Synching '".$fn."'... ";
# Build hash with all translations of current translation file
my %lang=&readlexicon($fn);
# Copy current translation file so that the old file could be overwritten with the new content
# while the copy is used to read from.
system ("cp $fn $fn.original");
open(IN,$fn.'.original') or die;
# Rebuild current translation file
# by writing all exisiting entries until SYNCMARKER
open(OUT,'>'.$fn) or die;
my $found=0;
while (<IN>) {
if ($_=~/\#\s*SYNCMARKER/) { $found=1; last; }
print OUT $_;
}
# Append missing phrases to new version of current translation file
# by synching old version of current translation file with master hash
if ($found) { # Only change files where SYNCMARKER was found
$i=0;
print OUT "\n\#SYNC ".localtime()."\n";
# Sync master with current translation file:
foreach my $key (sort keys %master) {
print "\n Checking key: '$key'" if $debug;
next unless ($key);
unless ($lang{$key}) {
# Translation helper?
if ($helper) {
$comment='';
my $copytrans=$key;
# Create comment based on already existing translations:
foreach (reverse sort keys %lang) {
$copytrans=~s/\Q$_\E/$lang{$_}/gsi; # \Q \E: escape meta characters
}
if (lc($copytrans) ne lc($key)) {
$comment='# '.$copytrans;
}
}
# Numbered?
$i++;
if ($numbered) {
$num=' ('.$i.')';
} else {
$num='';
}
# Find delimiter for key and value
if (($key=~/\'/) & ($key=~/\"/)) {
$quotwarn++;
print " (Warning: Both, ' and \", occur!)" if $debug;
}
# if (($key=~/[^\\]\'/) | ($key=~/\\\"/)) {
if ($key=~/\'/) {
$dlm='"';
} else {
$dlm="'";
}
# Write new entry to translation file
print OUT (<<ENDNEW);
$dlm$key$dlm
=> $dlm$key$num$dlm,
ENDNEW
if ($helper) {
print OUT $comment
}
print OUT "\n";
print " > added" if $debug;
}
}
# Add SYNCMARKER at end of file
print OUT "\n\#SYNCMARKER\n";
foreach (<IN>) {
print OUT $_;
}
}
close (IN);
close (OUT);
print "\n" if $debug;
print"$i added... ok.\n";
}
if ($quotwarn) {
print "Warning: Issues expected due to occurrence of ' and \" in $quotwarn new key(s).\n";
}
print "Synchronization completed.\n";
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>