# file KLEIDER/web/src/localization/NameReplacer.pm
# Namen durch abstrakte Zeichenfolgen ersetzen
# 2015-08-13 Herbert Schiemann <h.schiemann@herbaer.de>
# GPL Version 2 oder neuer

package Herbaer::Translate::NameReplacer ;

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

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

# liest eine Namensliste
sub _getdata {
   my ($self, $key) = @_ ;
   my $dbg = $self -> {"dbg"};
   print STDERR "Herbaer::Translate::NameReplacer::_getdata (\"$key\")\n" if $dbg;
   my $n = $self -> {"names"};
   my $l = [];
   $n -> {$key} = $l;
   my $k2;
   if ($key =~ /^([^_])+_/) {
      $k2 = $1;
   }
   my $p = catfile ($self -> {"dir"}, $key) ;
   if (! -f $p) {
      if ($k2) {
         if ($n -> {$k2}) {
            $n -> {$key} = $n -> {$k2};
            print STDERR
               "Herbaer::Translate::NameReplacer::_getdata: ",
               "\"$k2\" für Schlüssel \"$key\"\n"
               if $dbg;
            return $n -> {$key};
         }
         $n -> {$k2} = $l;
      }
      $p = catfile ($self -> {"dir"}, $k2) ;
   }
   if (! -f $p) {
      print STDERR
         "Herbaer::Translate::NameReplacer::_getdata: ",
         "\"default\" für Schlüssel \"$key\"\n"
         if $dbg;
      if ($k2) {
         $n -> {$k2} = $n -> {"default"};
         print STDERR
            "Herbaer::Translate::NameReplacer::_getdata: ",
            "\"default\" für Schlüssel \"$k2\"\n"
            if $dbg;
      }
      if ($n -> {"default"}) {
         $n -> {$key} = $n -> {"default"};
         $n -> {$k2}  = $n -> {"default"} if $k2;
         return $n -> {$key};
      }
      $n -> {"default"} = $l;
      $p = catfile ($self -> {"dir"}, "default");
   }
   my $h;
   my $ln;
   if (! open ($h, "<:encoding(utf-8)", $p)) {
      print STDERR "Herbaer::Translate::NameReplacer Kann Datei $p nicht lesen:$!\n"
         if $dbg;
      return $l;
   }
   while (defined ($ln = <$h>)) {
      next if $ln =~ /^#/ ;
      $ln =~ s/\s*$// ;
      $ln =~ s/^\s*// ;
      next unless $ln ;
      push (@$l, qr($ln) );
   }
   close $h;
   $l;
} # _getdata

sub _gettrans {
   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;
   }
   $trans;
} # _gettrans

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

   $srl =~ s/-.*// ;
   $tgl =~ s/-.*// ;
   my $key = "${srl}_${tgl}" ;
   my $xkc = {};
   my $names = $self -> {$key} || $self -> _getdata ($key);
   my $li;
   my $re;
   my $name;
   my $n = 1;
   for $li (@$names) {
      $re = $li;
      $key = "XKC${n}CKX";
      while ( $text =~ s/$re/$key/e ) {
         $name = $&;
         $name =~ s/\s+/ /;
         $xkc -> {$key} = $name ;
         if ($dbg) {
            print STDERR "KEY $key\n";
            print STDERR "NAME $name\n";
            print STDERR "TEXT $text\n";
         }
         ++$n;
         $key = "XKC${n}CKX";
      }
   }
   my $trans = $self -> _gettrans () or return "";
   my $tt = $trans -> translate ($text, $srl, $tgl);
   while ( ($key, $name) = each %$xkc ) {
      if ($dbg) {
         print STDERR "KEY $key\n";
         print STDERR "NAME $name\n";
         print STDERR "TT $tt\n";
      }
      $tt =~ s/$key/$name/e ;
   }
   return $tt;
} # translate

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

   my $trans = $self -> _gettrans ();
   $trans -> learn ($text, $srl, $tgl, $tt) if $trans;
} # learn

# Name des Uebersetzers
sub translator_name {
   my $self = shift;
   my $tn = "nr" ;
   my $trans = $self -> _gettrans ();
   $tn .= "_" . $trans -> translator_name () if $trans;
   $tn;
} # translator_name

# speichert die gelernten Daten
sub finish {
   my $self = shift;
   my $dbg = $self -> {"dbg"};
   if ($dbg) {
      print STDERR "Herbaer::Translate::NameReplacer::finish\n";
   }
   my $trans = $self -> {"trans"};
   $trans -> finish () if $trans;
} # finish

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