Return to synch.pl CVS log

Up to [LON-CAPA] / loncom / localize / localize

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";