# file KLEIDER/web/src/localization/WordReplacer.pm
# Texteile ersetzen zur Erleichterung der Übersetzung
# 2015-08-03 Herbert Schiemann, <h.schiemann@herbaer.de>
# GPL Version 2 oder neuer

package Herbaer::Translate::WordReplacer ;

use parent Herbaer::Translate::Base ;
use File::Spec::Functions qw (catfile) ;
use Herbaer::Translate ;
use utf8;

sub new {
   my ($class
       , $dir
       , $trname
       , $debug
      ) = @_;
   use File::Spec::Functions qw(rel2abs) ;
   $debug ||= 0;
   if ($debug) {
      print STDERR "Herbaer::Translate::WordReplacer::new\n";
   }
   $dir ||= "replacements";
   $dir = rel2abs($dir);
   if (! -d $dir) {
      print STDERR
         "  $dir ist kein Verzeichnis,\n",
         "  Wörter werden nicht ersetzt\n";
      $dir = undef;
   }
   my $self = {
      "dbg"    => $debug, 
      "dir"    => $dir,      # Verzeichnis der Wortersetzungstabellen
      "repl"   => {},        # lang, global -> [ [pattern, replacement | /RETURN ],]
      "trname" => $trname,
   } ;
   if ($dbd && $debug >= 1) {
      print STDERR "  Verzeichnis der Ersetzungen: $dir\n" ;
   }
   return bless ($self, $class);
} # new

# lädt den Übersetzer
sub _translator {
   my $self = shift;
   my $trans = $self -> {"trans"};
   if (! $trans) {
      $trans = new Herbaer::Translate ($self -> {"trname"});
      if (! $trans) {
         print STDERR "Kann Übersetzer \"", $self -> {"trname"}, "\" nicht laden.\n"
            if $self -> {"dbg"};
         return undef;
      }
      $self -> {"trans"} = $trans;
   }
   return $trans;
}

# liest eine Ersetzungstabelle
sub _getdata {
   my ($self, $key) = @_ ;
   my $debug = $self -> {"dbg"};
   if ($debug) {
      print STDERR "Herbaer::Translate::WordReplacer::_getdata (\"$key\")\n";
   }
   my $path = catfile ($self -> {"dir"}, $key) ;
   my $h;
   my $list = [];
   my $line;
   my $re;
   open ($h, "<:encoding(utf-8)", $path) or return ;
   while (defined ($line = <$h>)) {
      next if $line =~ /^#/ ;
      $line =~ s/\s*$// ;
      if ( $line =~ /\s*(\S+)\s+(.*)/ ) {
         $re = $1;
         print STDERR "REGEX $re\n" if $debug;
         push (@$list, [qr($re), $2]);
      }
   }
   close $h;
   if ($debug) {
      print STDERR "Herbaer::Translate::WordReplacer data\n";
      for $h (@$list) {
         print STDERR " ", $h->[0], " --> ", $h->[1], "\n";
      }
   }
   $self -> {"repl"} -> {$key} = $list;
} # _getdata

sub translate {
   my ($self, $text, $srl, $tgl) = @_ ;
   my $debug = $self -> {"dbg"};
   if ($debug) {
      print STDERR "Herbaer::Translate::WordReplacer::translate\n";
   }
   # Parameter können sinnvoller geprüft werden.
   $text || return;
   $srl  || return;
   $tgl  || return;

   my $trans = $self -> _translator ();
   return "" unless $trans;

   $srl =~ s/-.*// ;
   $tgl =~ s/-.*// ;
   my $tt;
   $tt = $trans -> translate ($text, $srl, $tgl);
   return "" unless $tt;

   my $key;    # Schlüssel zur Ersetzungsliste
   my $list;   # Liste der Ersetzungen
   my $stext;  # Text-Sicherung
   my $stt;    # Ersetzungstest-Sicherung
   my $li;     # Listeneintrag
   my $re;     # Regex
   my $repl;   # Ersetzungsausdruck
   for $key ("${srl}_${tgl}", $srl) {
      my $list = $self -> {"repl"} -> {$key}; # Liste der sprachabhängigen Ersetzungen
      if (!$list) {
         $self -> _getdata ($key);
         $list = $self -> {"repl"} -> {$key};
      }
      for $li (@$list) {
         $re   = $li -> [0];
         $repl = $li -> [1];
         if ($debug) {
            print STDERR
               "WordReplacer RE $re\n",
               "WordReplacer TT $tt\n";
         }
         if ($tt =~ $re) {
            next if $repl eq "/RETURN" ;
            $stext = $text;
            $stt   = $tt;
            if ($debug) {
               print STDERR
                  "WordReplacer TRY TEXT REPLACE $text\n",
                  "WordReplacer EVAL " . "\$text =~ s/$re/\"$repl\"/ge" . "\n";
            }
            if (eval ("\$text =~ s/$re/\"$repl\"/ge")) {
               $tt = $trans -> translate ($text, $srl, $tgl);
               if ($debug) {
                  print STDERR
                     "WordReplacer TEXT REPLACE $text\n",
                     "WordReplacer NEW TT $tt\n";
               }
               if ( $tt =~ $re ) {
                  # Die Ersetzung hat nicht genutzt
                  print STDERR "WordReplacer ROLLBACK\n" if $debug;
                  $tt   = $stt;
                  $text = $stext;
               }
            }
         }
         else {
            print STDERR "WordReplacer NO MATCH $repl\n" if $debug;
            last if $repl eq "/RETURN" ;
         }
      }
   }
   return $tt;
} # translate

sub learn {
   my ($self, $text, $srl, $tgl, $tt) = @_ ;
   my $debug = $self -> {"dbg"};
   if ($debug) {
      print STDERR "Herbaer::Translate::WordReplacer::learn\n";
   }
   my $trans = $self -> _translator ();
   $learn -> translate ($text, $srl, $tgl, $tt) if $trans;
} # learn

sub finish {
   my $self = shift;
   my $debug = $self -> {"dbg"};
   if ($debug) {
      print STDERR "Herbaer::Translate::WordReplacer::finish\n";
   }
   my $trans = $self -> {"trans"};
   $trans -> finish () if $trans;
} # finish

# Name des zuletzt aktiven Uebersetzers
sub translator_name {
   my $self = shift;
   my $debug = $self -> {"dbg"};
   if ($debug) {
      print STDERR "Herbaer::Translate::WordReplacer::translator_name\n";
   }
   my $trans = $self -> {"trans"};
   if ($trans) {
      return "wr_" . $trans -> translator_name ();
   }
   else {
      return "wr_error";
   }
} # translator_name

1;
# end of file KLEIDER/web/src/localization/WordReplacer.pm