#!/usr/bin/perl

#--------------------------------------------------------------------------
# pron_predict.pl
# Version 1.0
# Author: Marelie Davel (marelie.davel@gmail.com)
#--------------------------------------------------------------------------

use warnings;
use strict; 
use open IO => ':encoding(utf8)';
use open ':std';

my $dbg=0;          # set to 1 for debugging info to be displayed
my %languages = ( 'afr', 1, 'eng', 1, 'nbl', 1, 'xho', 1, 'zul', 1, 'nso', 1, 'tsn', 1, 'sot', 1, 'ssw', 1, 'ven', 1, 'tso', 1);

sub print_usage() {
  printf "Predict language-specific pronunciations for a given word list.\n";
  printf "Usage: pron_predict.pl <in:words> <language> <out:dict>\n";
  printf "       <words>     word list, one word per line, UTF8-encoded.\n";
  printf "       <language>  specified using ISO code:\n";
  printf "                   %s\n", (join ' | ', sort keys %languages);
  printf "       <dict>      name of new output dictionary to be created\n";
  printf "                   as a tab-delimited, UTF8-encoded file.\n";
}

#--------------------------------------------------------------------------
# HELPER READ FUNCTIONS
#--------------------------------------------------------------------------

sub fread_gnull_list($\%) {
  my ($gnull_fn, $gnull_p) = @_;
  open IH, "<:encoding(utf8)", $gnull_fn or die "ERROR: cannot open $gnull_fn for reading.\n";
  while (<IH>) {
    chomp;
    my @line=split /;/;
    if (scalar @line != 2) {
      die "ERROR: format error in gnulls file $gnull_fn, line $_\n";
    }
    $gnull_p->{$line[0]}=$line[1];
  }
  close IH;
}

#--------------------------------------------------------------------------

sub fread_rules_olist($\%\%) {
  my ($rule_fn, $rules_p, $order_p) = @_;
  open RH, "<:encoding(utf8)", $rule_fn or die "ERROR: cannot open $rule_fn for reading.\n";
  my ($grph, $left, $right, $phn, $cnt, $numi);
  while (<RH>) {
    chomp;
    my @line=split ";";
    if (scalar @line==5) {
      ($grph,$left,$right,$phn,$cnt) = @line;
      $numi=0;
    } elsif (scalar @line==6) {
      ($grph,$left,$right,$phn,$cnt,$numi) = @line;
    } else {
      die "ERROR: problem with rule format in $rule_fn line $_";
    }
    my $pattern = "$left-$grph-$right";
    $rules_p->{$pattern} = $phn;
    $order_p->{$grph}[$cnt]=$pattern;
    }
    close RH;
}

#--------------------------------------------------------------------------

sub fread_words($$\@) {
  my ($in_fn, $gmap_fn, $word_p) = @_;
  open IH, "<:encoding(utf8)", $in_fn or die "ERROR: cannot open $in_fn for reading.\n";
  open GH, "<:encoding(utf8)", $gmap_fn or die "ERROR: cannot open $gmap_fn for reading.\n";

  my %gmap = ();
  while (<GH>) {
    chomp;
    my @parts = split /\t/;
    if (scalar @parts !=2) {
      printf "ERROR: format error in mapping file $gmap_fn at line '$_'\n";
      die;
    }
    my ($funny, $std) = @parts;
    $gmap{$funny} = $std;
  }
  close GH;
   
  while (<IH>) {
    chomp;
    if (/[-\s;,\.]/) {
      die "ERROR: format error in words file $in_fn, line $_\n";
    }
    my $word = lc $_;
    my $gstr = "";
    foreach my $l (split //,$word) {
      if (exists $gmap{$l}) {
        $gstr = $gstr.$gmap{$l};
      } else {
        $gstr = $gstr.$l;
      }
    }
    push @$word_p, $gstr;
  }
  close IH;
}

#--------------------------------------------------------------------------
# HELPER PREDICT FUNCTIONS
#--------------------------------------------------------------------------

sub add_gnull_word($\%) {
  my ($word,$gnull_p) = @_;
  while (my ($gfind,$greplace)=each %{$gnull_p}) {
    my $tail = "";
    if ($word =~ /(.*)_(.*)/) {
        $word=$1;
        $tail=$2;
    }
    $word = " ".$word." ";
    if ($word =~ /$gfind/) {
      $word =~ s/$gfind/$greplace/g;
    }
    $word=~s/ //g;
    if (!($tail eq "")) {
      $word=$word."_".$tail;
    }
  }
  return $word;
}

#--------------------------------------------------------------------------

sub g2p_word_olist($\%\%) {
  my ($word, $rules_p, $order_p) = @_;
  chomp $word;
  my @slist=();
  my $wordend = (length $word)-1;
  my $l = " ";
  my $g = substr $word,0,1;
  my $r;
  if ($wordend>0) {
    $r = (substr $word,1)." ";
  } else {
      $r = " ";
  }

  #foreach graph->phone
  foreach my $i (0 .. $wordend) {
    if (! exists $order_p->{$g}) {
      printf "WARNING: ignoring unknown character '$g' in word '$word'\n";
      $slist[$i] = "";
    } else {
      my @rlist = @{$order_p->{$g}};
      my $ri = $#rlist;
      my $found = 0;
      my $rmatch = "";
      my $pat = $l."-".$g."-".$r;
      while ($ri>=0) {
        if ($pat =~ /$rlist[$ri]/) {
           $found = 1;
           $rmatch = $rlist[$ri];
           last;
        }
        $ri--;
      }
      if ($found==0) {
        die "No matching rule found! [$word][$i]\n";
      } else {
        $slist[$i] = $rules_p->{$rmatch};
        print "[$rmatch] -> $slist[$i]\n" if $dbg==1;
      }
    }
    $l = $l.$g;
    $g = substr $r,0,1;
    $r=substr $r,1;
  }
  my $pstr = join "",@slist;
  $pstr =~ s/0//g;
  print "DBG: $word -> [$pstr]\n" if $dbg==1;
  return $pstr;
}

#--------------------------------------------------------------------------

sub predict_list(\@\%\%\%\%) {
  my ($words_p, $rules_p, $order_p, $gnull_p, $dict_p) = @_;
  foreach my $word (@$words_p) {
    my $to_predict = add_gnull_word($word, %$gnull_p);
    $dict_p->{$word} = g2p_word_olist($to_predict, %$rules_p, %$order_p);
  }
  close IH;
}

#--------------------------------------------------------------------------
# HELPER WRITE FUNCTIONS
#--------------------------------------------------------------------------

sub fwrite_dict(\%$) {
  my ($dict_p, $dict_fn) = @_;
  open OH, ">:encoding(utf8)", $dict_fn or die "ERROR: cannot open file $dict_fn for writing";
  foreach my $word (sort keys %{$dict_p}) {
    printf OH "%s\t%s\n", $word, $dict_p->{$word};
  }
  close OH;
}

sub remap_dict(\%$$) {
  my ($dict_p, $gmap_fn, $pmap_fn) = @_;
  open GH, "<:encoding(utf8)", $gmap_fn or die "ERROR: cannot open $gmap_fn for reading.\n";
  open PH, "<:encoding(utf8)", $pmap_fn or die "ERROR: cannot open $pmap_fn for reading.\n";

  my %gmap = ();
  while (<GH>) {
    chomp;
    my @parts = split /\t/;
    if (scalar @parts !=2) {
      printf "ERROR: format error in mapping file $gmap_fn at line '$_'\n";
      die;
    }
    my ($funny, $std) = @parts;
    $gmap{$std} = $funny;
  }
  close GH;
   
  my %pmap = ();
  while (<PH>) {
    chomp;
    my @parts = split /\t/;
    if (scalar @parts !=2) {
      printf "ERROR: format error in mapping file $pmap_fn at line '$_'\n";
      die;
    }
    my ($std, $funny) = @parts;
    $pmap{$std} = $funny;
  }
  close PH;

  foreach my $word (keys %$dict_p) {
    my $pron = $dict_p->{$word};
    my $gstr = "";
    foreach my $l (split //,$word) {
      if (exists $gmap{$l}) {
        $gstr = $gstr.$gmap{$l};
      } else {
        $gstr = $gstr.$l;
      }
    }
    my @plist = ();
    foreach my $p (split //,$pron) {
      if (exists $pmap{$p}) {
       push @plist, $pmap{$p};
      } else {
       push @plist, $p;
      }
    }
    delete $dict_p->{$word};
    $dict_p->{$gstr} = join ' ',@plist;
  }
}

#--------------------------------------------------------------------------
# MAIN FUNCTIONS
#--------------------------------------------------------------------------

sub predict_file ($$$$$$) {
  my ($words_fn, $rule_fn, $gnull_fn, $gmap_fn, $pmap_fn, $out_fn) = @_;
  my (@words, %gnulls, %rules, %order, %dict) = ((), (), (), (), ());
  fread_words($words_fn, $gmap_fn, @words);
  fread_rules_olist($rule_fn, %rules, %order);
  fread_gnull_list($gnull_fn, %gnulls);
  predict_list(@words, %rules, %order, %gnulls, %dict);
  remap_dict(%dict, $gmap_fn, $pmap_fn);
  fwrite_dict(%dict, $out_fn);
}

#--------------------------------------------------------------------------

sub pron_predict ($$$) {
  my ($in_fn, $lang, $out_fn) = @_;
  if (not exists $languages{$lang}) {
    printf "ERROR: Unknown language '$lang'\n";
    printf "Use: %s\n", (join ' | ', sort keys %languages);
    die 
  }
  if (not exists $ENV{'DR_RULE_DIR'}) {
    printf "ERROR: Please set the 'DR_RULE_DIR' variable first\n";
    die
  }
  my $src_dir = $ENV{'DR_RULE_DIR'};
  my $rule_fn = "$src_dir/nchlt_$lang.rules";
  my $gnull_fn = "$src_dir/nchlt_$lang.gnulls";
  my $gmap_fn = "$src_dir/nchlt_$lang.map.graphs";
  my $pmap_fn = "$src_dir/nchlt_$lang.map.phones";
  predict_file($in_fn, $rule_fn, $gnull_fn, $gmap_fn, $pmap_fn, $out_fn);
}

#--------------------------------------------------------------------------

if (scalar @ARGV == 3) {
  pron_predict $ARGV[0], $ARGV[1], $ARGV[2]; 
} else {
  print_usage;
  exit;
}

#--------------------------------------------------------------------------

