File:  [LON-CAPA] / loncom / localize / localize / synch.pl
Revision 1.8: download - view: text, annotated - select for diffs
Thu Jul 10 19:10:26 2008 UTC (15 years, 10 months ago) by bisitz
Branches: MAIN
CVS tags: version_2_8_X, version_2_8_2, version_2_8_1, version_2_8_0, version_2_7_99_1, version_2_7_99_0, HEAD, GCI_1
- Added some comments to explain what's going on.
- Corrected matching operation for the search of already existing translations.
Now, words aren't considered as regular expressions anymore (which could have caused the script aborted) and execution time is much shorter now.
Execution works fine with UTF-8 encoded language files.

Thanks to Stefan Dröschler for his help!
Nevertheless, more testing is recommended.

#$numbered=1;

sub readlexicon {
    my $fn=shift;
    open(IN,$fn);
    my %lexicon=();
    my $contents=join('',<IN>);
    close(IN);
    $contents=~s/package Apache\:[^\;]+//;
    $contents=~s/use base[^\;]+//;
    eval($contents.'; %lexicon=%Lexicon;');
    delete $lexicon{'_AUTO'};
    delete $lexicon{'char_encoding'};
    delete $lexicon{'language_code'};
    return %lexicon;
}

sub readnew {
    open(IN,'newphrases.txt');
    my %lexicon='';
    while (my $line=<IN>) {
	chomp($line);
	$lexicon{$line}=$line;
    }
    close(IN);
    return %lexicon;
}

# ==== Main Program

my %master=&readnew();

foreach (<*.pm>) {
    print "Reading: ".$_."\n";
    %master=(%master,&readlexicon($_));
}

# Remove obsolete from synch

open(IN,'removephrases.txt');
while (my $line=<IN>) {
    chomp($line);
    delete $master{$line};
}
close(IN);


foreach my $fn (<*.pm>) {
    print "Synching: ".$fn."\n";
    my %lang=&readlexicon($fn);
    system ("cp $fn $fn.original");
    open(IN,$fn.'.original');
    open(OUT,'>'.$fn);
    my $found=0;
    # Rebuild current translation file until SYNCMARKER:
    while (<IN>) {
	if ($_=~/\#\s*SYNCMARKER/) { $found=1; last; } 
	print OUT $_;
    }
    if ($found) {
	$i=0;
	print OUT "\n\#SYNC ".localtime()."\n";
        # Sync master with current translation file:
	foreach my $key (sort keys %master) {
	    unless ($key) { next; }
	    unless ($lang{$key}) {
		my $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;
                }
		if ($numbered) {
		    $i++;
		    $num=' ('.$i.')';
		} else {
		    $num='';
		}
		if ($key=~/\'/) {
		    $del='"';
		} else {
		    $del="'";
		}
		print OUT (<<ENDNEW);
   $del$key$del
=> $del$key$num$del,
$comment
ENDNEW
	    }
	}

	print OUT "\n\#SYNCMARKER\n";
	foreach (<IN>) {
	    print OUT $_;
	}
    }
    close (IN);
    close (OUT);
}

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>