[BACK]Return to synch.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / localize / localize

Diff for /loncom/localize/localize/synch.pl between versions 1.8 and 1.15

version 1.8, 2008/07/10 19:10:26 version 1.15, 2013/12/20 12:29:06
Line 1 Line 1
 #$numbered=1;  #!/usr/bin/perl
   # The LearningOnline Network with CAPA
   # $Id$
   
   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 {  sub readlexicon {
       # Read translation file into memory
     my $fn=shift;      my $fn=shift;
     open(IN,$fn);      open(IN,$fn) or die;
     my %lexicon=();      my %lexicon=();
     my $contents=join('',<IN>);      my $contents=join('',<IN>);
     close(IN);      close(IN);
       # Tidy up: remove header data
     $contents=~s/package Apache\:[^\;]+//;      $contents=~s/package Apache\:[^\;]+//;
     $contents=~s/use base[^\;]+//;      $contents=~s/use base[^\;]+//;
       # Build hash with hash from file
       my %Lexicon=();
     eval($contents.'; %lexicon=%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{'_AUTO'};
     delete $lexicon{'char_encoding'};      delete $lexicon{'char_encoding'};
     delete $lexicon{'language_code'};      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;      return %lexicon;
 }  }
   
 sub readnew {  sub readnew {
     open(IN,'newphrases.txt');      print "\n" if $debug;
     my %lexicon='';      open(IN,'newphrases.txt') or die;
       my %lexicon=();
     while (my $line=<IN>) {      while (my $line=<IN>) {
  chomp($line);          chomp($line);
  $lexicon{$line}=$line;          next if ($line eq '');
           $lexicon{$line}=$line;
           print "    New entry: '$line'\n" if $debug;
     }      }
     close(IN);      close(IN);
     return %lexicon;      return %lexicon;
 }  }
   
 # ==== Main Program  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();  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>) {  foreach (<*.pm>) {
     print "Reading: ".$_."\n";      if (&takethisfile($_)) {
     %master=(%master,&readlexicon($_));          print "  Reading '".$_."'... ";
           %master=(%master,&readlexicon($_));
          print "ok.\n";
       }
 }  }
   
 # Remove obsolete from synch  # 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.
 open(IN,'removephrases.txt');  # 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>) {  while (my $line=<IN>) {
     chomp($line);      chomp($line);
       next if ($line eq '');
     delete $master{$line};      delete $master{$line};
       $rm++;
 }  }
 close(IN);  close(IN);
   print "$rm removed... ok.\n";
   
   
   print "Synchronization:\n";
   my $quotwarn=0;
 foreach my $fn (<*.pm>) {  foreach my $fn (<*.pm>) {
     print "Synching: ".$fn."\n";      if (!&takethisfile($fn)) { next }
       print "  Synching '".$fn."'... ";
       # Build hash with all translations of current translation file
     my %lang=&readlexicon($fn);      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");      system ("cp $fn $fn.original");
     open(IN,$fn.'.original');      open(IN,$fn.'.original') or die;
     open(OUT,'>'.$fn);      # Rebuild current translation file
       # by writing all exisiting entries until SYNCMARKER
       open(OUT,'>'.$fn) or die;
     my $found=0;      my $found=0;
     # Rebuild current translation file until SYNCMARKER:  
     while (<IN>) {      while (<IN>) {
  if ($_=~/\#\s*SYNCMARKER/) { $found=1; last; }    if ($_=~/\#\s*SYNCMARKER/) { $found=1; last; }
  print OUT $_;   print OUT $_;
     }      }
     if ($found) {      # 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;   $i=0;
  print OUT "\n\#SYNC ".localtime()."\n";   print OUT "\n\#SYNC ".localtime()."\n";
         # Sync master with current translation file:          # Sync master with current translation file:
  foreach my $key (sort keys %master) {   foreach my $key (sort keys %master) {
     unless ($key) { next; }      print "\n    Checking key: '$key'" if $debug;
       next unless ($key);
     unless ($lang{$key}) {      unless ($lang{$key}) {
  my $comment='';                  # Translation helper?
  my $copytrans=$key;                  if ($helper) {
                 # Create comment based on already existing translations:      $comment='';
  foreach (reverse sort keys %lang) {      my $copytrans=$key;
     $copytrans=~s/\Q$_\E/$lang{$_}/gsi; # \Q \E: escape meta characters                      # Create comment based on already existing translations:
  }      foreach (reverse sort keys %lang) {
  if (lc($copytrans) ne lc($key)) {          $copytrans=~s/\Q$_\E/$lang{$_}/gsi; # \Q \E: escape meta characters
     $comment='# '.$copytrans;      }
       if (lc($copytrans) ne lc($key)) {
           $comment='# '.$copytrans;
                       }
                 }                  }
                   # Numbered?
    $i++;
  if ($numbered) {   if ($numbered) {
     $i++;  
     $num=' ('.$i.')';      $num=' ('.$i.')';
  } else {   } else {
     $num='';      $num='';
  }   }
                   # Find delimiter for key and value
                   if (($key=~/\'/) & ($key=~/\"/)) {
                       $quotwarn++;
                       print " (Warning: Both, ' and \", occur!)" if $debug;
                   }
    # if (($key=~/[^\\]\'/) | ($key=~/\\\"/)) {
  if ($key=~/\'/) {   if ($key=~/\'/) {
     $del='"';      $dlm='"';
  } else {   } else {
     $del="'";      $dlm="'";
  }   }
  print OUT (<<ENDNEW);                  # Write new entry to translation file
    $del$key$del                  print OUT (<<ENDNEW);
 => $del$key$num$del,     $dlm$key$dlm
 $comment  => $dlm$key$num$dlm,
 ENDNEW  ENDNEW
     }                  if ($helper) {
  }                      print OUT $comment
                   }
                   print OUT "\n";
    print " > added" if $debug;
               }
           }
           # Add SYNCMARKER at end of file
  print OUT "\n\#SYNCMARKER\n";   print OUT "\n\#SYNCMARKER\n";
  foreach (<IN>) {   foreach (<IN>) {
     print OUT $_;      print OUT $_;
Line 99  ENDNEW Line 222  ENDNEW
     }      }
     close (IN);      close (IN);
     close (OUT);      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";
   
Removed from v.1.8  
changed lines
  Added in v.1.15

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