#!/usr/bin/perl -lw

use strict;
use warnings;
use utf8;

use File::Next;
use File::Basename;
use File::Path qw/make_path/;
use File::Copy;
#use XML::Simple qw(:strict);
use XML::Simple;
use Data::Dumper;


my $word  = "___";
my $lemma = "___";
my $pos   = "___";
my $msd   = "___";
my $sID   = "___";
my $pID   = "___";
my $depRel = "___";
my $analysis  = "___";
my $tmpLemma = '';
my $tmpPOS = '';
my $tmpMSD = '';
my $newCohort = 1;
my $firstLine = 1;
my $sentCounter = "1";
my %dep_rel = ();
my %domain_map = ();
my $lang = 'sme';
my $cr_type = 'fc';
my $date = '2016-11-15';
my $rootDir = "data2test";
my $inDir = "./$rootDir/01_$date/$cr_type/$lang";
my $outDir = '03_corpus_fc';
my $corpus_name = $lang.'_corpus_'.$date;
my $realLemma = "___";
my $ismeFile = '/Users/cipriangerstenberger/main/langs/'.$lang.'/src/generator-gt-norm.xfst';
my $tmp_dir = 'tmp_'.$lang.'_'.$cr_type;
my $gs = 'c_gtest.script';
my $isDer = 'no';

#################################
# subroutines
sub get_msd
{
  local($a) = @_;
  #remove sem- and other tags
  $a =~ s/Use\/[^\s]+ //g;
  $a =~ s/Sem\/[^\s]+ //g;
  $a =~ s/Err\/[^\s]+ //g;

  # #remove syntax labels such as
  # N Sg Nom <ext> @<SUBJ #3->2
  # and
  # <ctjHead> V TV Inf @IMV #13->11
  
  $a =~ s/<[^>]+> / /g;
    
  #split the relation and find selfID and parentID
  my ($hd, $slf, $prt) = $a =~ m/^(.*)#(\d+)->(\d+)$/;
  #split the function
  my ($r, $fct) = split(/\@/, $hd, 2);
  my $rest = trim($r);
  my $sfct = trim($fct);

  my ($vPOS, $vMSD) = $rest =~m/^([^\s]+)(.*)$/;
  # store these values temporarily in case the generation of correct derivation lemma results into '???'
  $tmpPOS = $vPOS;
  $tmpMSD = $vMSD;

  
  # process pseudo-pos for all POS* derivations for sme
  if ($vPOS =~ m/AA/ || $vPOS =~ m/NN/ || $vPOS =~ m/VV/)  {
    chop $vPOS;

    $isDer = 'ye';
    my $rPos = '';
    my $rBF = '';

    if ($vMSD =~ m/ V /)  {
      $rPos = 'V';
      $tmpPOS = 'V';
      $rBF = 'Inf';
    }
    if ($vMSD =~ m/ N /)  {
      $rPos = 'N';
      $tmpPOS = 'N';
      $rBF = 'Sg+Nom';
    }
    if ($vMSD =~ m/ A /)  {
      $rPos = 'A';
      $tmpPOS = 'A';
      $rBF = 'Attr';
    }
    if ($vMSD =~ m/ Adv/)  {
      $rPos = 'Adv';
      $tmpPOS = 'Adv';
      $rBF = '';
    }
    
    ($vPOS,$vMSD) = generate_correct_lemma($vPOS, $vMSD, $rPos, $rBF);
  }
  
  $vMSD =~ s/^\s+//;
  $vMSD =~ s/\s+$//;
  $vMSD =~ s/ /\./g;
  $vMSD =~ s/\//_/g;

  if ($sfct eq "" || $sfct eq "\?")  {
    $sfct = "___";
  }
  if ($prt eq "" || $prt eq "\?")  {
    $prt = "___";
  }
  if ($slf eq "" || $slf eq "\?")  {
    $slf = "___";
  }
  if ($vPOS eq "" || $vPOS eq "\?")  {
    $vPOS = "___";
  }
  if ($vMSD eq "" || $vMSD eq "\?")  {
    $vMSD = $vPOS;
  }
  else  {
    $vMSD = $vPOS.'.'.$vMSD;
  }

  #print STDERR "h ".$h."s ".$s."p ".$p."\n";
  return ($vPOS,$vMSD,$slf,$prt,$sfct, $isDer);
}

sub generate_correct_lemma()
{
  my ($ps,$md,$rp,$rb) = @_;

  my $i = '';
  my $dHist = '';
  my $realMSD = '';
  my $o_dHist = '';
  my $str4gen = '';
  
  # special treatment of Adv
  if($rp eq 'Adv') 
    {
      $i = rindex($md,' '.$rp);
      $dHist = substr($md,0,$i);
      $realMSD = '';
    }
  else {
    $i = rindex($md,' '.$rp.' ');
    $dHist = substr($md,0,$i);
    $realMSD = substr($md,$i+3);
  }
  
  $dHist =~ s/^\s+//;
  $dHist =~ s/\s+$//;
  $dHist =~ s/ /\+/g;
  $dHist =~ s/AA\+/A\+/g;
  $dHist =~ s/NN\+/N\+/g;
  $dHist =~ s/VV\+/V\+/g;
  
  $str4gen = $lemma.'+'.$ps.'+'.$dHist.'+'.$rp;
  
  # add real baseform info for non-adv items
  if($rp ne 'Adv')
    {
      $str4gen = $str4gen.'+'.$rb;
    }

  print STDERR "str4gen __ ".$str4gen."\n";

  open (XFILE, '>', "$tmp_dir/in.gtest");
  print XFILE $str4gen."\n"; 
  close XFILE;
  
  $realLemma = `xfst -q -utf8 < $tmp_dir/$gs`;

  print LSFILE "str4gen ".$str4gen."\n"; 
  print LSFILE "realLemma_orig |".$realLemma."|\n"; 


  $realLemma =~ s/^\s+//;
  $realLemma =~ s/\s+$//;
  $realLemma =~ s/\n/===/g;

  $realLemma =~ s/===\?\?\?//;

  print LSFILE "realLemma_changed |".$realLemma."|\n"; 
  my $current_score = 111;
  
  if ($realLemma =~ /===/) {
    my @candidates = split(/===/, $realLemma);
    
    for my $el (@candidates) {
      my $current_LVST = levenshtein($word, $el);
      
      if ($current_LVST < $current_score) {
	$current_score = $current_LVST;
	$realLemma = $el;
      } else {
	next;
      }
    }
  }
  
  $realMSD =~ s/^\s+//;
  $realMSD =~ s/\s+$//;
  $realMSD =~ s/ /\./g;
  $realMSD =~ s/\//_/g;

  #print STDERR "_lm_ ".$lemma." _dHist_ ".$dHist." _realMSD_ ".$realMSD." ___".$md."___\n";

  #return ($xpos,$xmsd);
  return ($rp, $realMSD)
}

sub reset_var
{
  $word  = "___";
  $pos   = "___";
  $lemma = "___";
  $sID   = "___";
  $pID   = "___";
  $depRel    = "___";
  $analysis  = "___";
  $isDer = 'no';
  $newCohort = 0;
}


# remove quotation marks from the lemma, replace spaces by underscore and # by the empty string
sub unhtmlize
{
    my $string = shift;
    $string =~ s/&/&amp;/g;
    $string =~ s/</&lt;/g;
    $string =~ s/>/&gt;/g;
    $string =~ s/\"//g;
    return $string;
}


# Perl trim function to remove whitespace from the start and end of the string
sub dtrim
{
    my $string = shift;
    $string =~ s/^\$//;
    return $string;
}

# remove quotation marks from the lemma, replace spaces by underscore and # by the empty string
sub lemma_trim
{
    my $string = shift;
    $string =~ s/\"$//;
    $string =~ s/ /_/g;
    $string =~ s/#//g;
    return $string;
}

# Perl trim function to remove whitespace from the start and end of the string
sub trim
{
    my $string = shift;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    return $string;
}

sub init_dep
  {
    %dep_rel = (
		
		">A" => 	"&gt;A",
		">ADVL" => 	"&gt;ADVL",
		">CC" => 	"&gt;CC",
		">N" => 	"&gt;N",
		">Num" => 	"&gt;Num",
		">P" => 	"&gt;P",
		">Pron" => 	"&gt;Pron",
		"<ADVL" => 	"&lt;ADVL",
		"<OBJ" => 	"&lt;OBJ",
		"<OPRED" => 	"&lt;OPRED",
		"<PPRED" => 	"&lt;PPRED",
		"<SPRED" => 	"&lt;SPRED",
		"<SUBJ" => 	"&lt;SUBJ",
		"+FMAINV" => 	"+FMAINV",
		"-F<ADVL" => 	"-F&lt;ADVL",
		"-F<OBJ" => 	"-F&lt;OBJ",
		"-F<OPRED" => 	"-F&lt;OPRED",
		"-F<SUBJ" => 	"-F&lt;SUBJ",
		"-FADVL>" => 	"-FADVL&gt;",
		"-FMAINV" => 	"-FMAINV",
		"-FOBJ>" => 	"-FOBJ&gt;",
		"-FSUBJ>" => 	"-FSUBJ&gt;",
		"A<" => 	"A&lt;",
		"ADVL" => 	"ADVL",
		"ADVL>" => 	"ADVL&gt;",
		"ADVL>CS" => 	"ADVL&gt;CS",
		"ADVL<" => 	"ADVL&lt;",
		"APP-ADVL<" => 	"APP-ADVL&lt;",
		"APP-N<" => 	"APP-N&lt;",
		"APP-Pron<" => 	"APP-Pron&lt;",
		"CNP" => 	"CNP",
		"COMP-CS<" => 	"COMP-CS&lt;",
		"CVP" => 	"CVP",
		"FAUX" => 	"FAUX",
		"FMV" => 	"FMV",
		"FMVdic" => 	"FMVdic",
		"FS-<ADVL" => 	"FS-&lt;ADVL",
		"FS-<SUBJ" => 	"FS-&lt;SUBJ",
		"FS-ADVL>" => 	"FS-ADVL&gt;",
		"FS-IAUX" => 	"FS-IAUX",
		"FS-IMV" => 	"FS-IMV",
		"FS-N<" => 	"FS-N&lt;",
		"FS-N<IAUX" => 	"FS-N&lt;IAUX",
		"FS-N<IMV" => 	"FS-N&lt;IMV",
		"FS-OBJ" => 	"FS-OBJ",
		"FS-P<" => 	"FS-P&lt;",
		"FS-VFIN<" => 	"FS-VFIN&lt;",
		"HNOUN" => 	"HNOUN",
		"IAUX" => 	"IAUX",
		"ICL-OBJ" => 	"ICL-OBJ",
		"ICL-SUBJ" => 	"ICL-SUBJ",
		"IMV" => 	"IMV",
		"IMVdic" => 	"IMVdic",
		"INTERJ" => 	"INTERJ",
		"N<" => 	"N&lt;",
		"Num<" => 	"Num&lt;",
		"OBJ>" => 	"OBJ&gt;",
		"OPRED>" => 	"OPRED&gt;",
		"P<" => 	"P&lt;",
		"PCLE" => 	"PCLE",
		"Pron<" => 	"Pron&lt;",
		"S<" => 	"S&lt;",
		"SPRED>" => 	"SPRED&gt;",
		"SPRED<OBJ" => 	"SPRED&lt;OBJ",
		"SUBJ>" => 	"SUBJ&gt;",
		"VOC" => 	"VOC",
		"X" => 	"X"
	       );
    
    %domain_map = (
		   "admin" => "administration",
		   "bible" => "bible",
		   "facta" => "facts",
		   "ficti" => "fiction",
		   "laws" => "law",
		   "news" => "news",
		   "science" => "science",
		   "___" => "___"
		  );
  }
  
#
# http://eli.thegreenplace.net/files/prog_code/levenshtein.pl.txt
#
# Return the Levenshtein distance (also called Edit distance) 
# between two strings
#
# The Levenshtein distance (LD) is a measure of similarity between two
# strings, denoted here by s1 and s2. The distance is the number of
# deletions, insertions or substitutions required to transform s1 into
# s2. The greater the distance, the more different the strings are.
#
# The algorithm employs a promimity matrix, which denotes the 
# distances between substrings of the two given strings. Read the 
# embedded comments for more info. If you want a deep understanding 
# of the algorithm, printthe matrix for some test strings 
# and study it
#
# The beauty of this system is that nothing is magical - the distance
# is intuitively understandable by humans
#
# The distance is named after the Russian scientist Vladimir
# Levenshtein, who devised the algorithm in 1965
#
sub levenshtein
{
    # $s1 and $s2 are the two strings
    # $len1 and $len2 are their respective lengths
    #
    my ($s1, $s2) = @_;
    my ($len1, $len2) = (length $s1, length $s2);

    # If one of the strings is empty, the distance is the length
    # of the other string
    #
    return $len2 if ($len1 == 0);
    return $len1 if ($len2 == 0);

    my %mat;

    # Init the distance matrix
    #
    # The first row to 0..$len1
    # The first column to 0..$len2
    # The rest to 0
    #
    # The first row and column are initialized so to denote distance
    # from the empty string
    #
    for (my $i = 0; $i <= $len1; ++$i)
    {
        for (my $j = 0; $j <= $len2; ++$j)
        {
            $mat{$i}{$j} = 0;
            $mat{0}{$j} = $j;
        }

        $mat{$i}{0} = $i;
    }

    # Some char-by-char processing is ahead, so prepare
    # array of chars from the strings
    #
    my @ar1 = split(//, $s1);
    my @ar2 = split(//, $s2);

    for (my $i = 1; $i <= $len1; ++$i)
    {
        for (my $j = 1; $j <= $len2; ++$j)
        {
            # Set the cost to 1 iff the ith char of $s1
            # equals the jth of $s2
            # 
            # Denotes a substitution cost. When the char are equal
            # there is no need to substitute, so the cost is 0
            #
            my $cost = ($ar1[$i-1] eq $ar2[$j-1]) ? 0 : 1;

            # Cell $mat{$i}{$j} equals the minimum of:
            #
            # - The cell immediately above plus 1
            # - The cell immediately to the left plus 1
            # - The cell diagonally above and to the left + the cost
            #
            # We can either insert a new char, delete a char of
            # substitute an existing char (with an associated cost)
            #
            $mat{$i}{$j} = min([$mat{$i-1}{$j} + 1,
                                $mat{$i}{$j-1} + 1,
                                $mat{$i-1}{$j-1} + $cost]);
        }
    }

    # Finally, the distance equals the rightmost bottom cell
    # of the matrix
    #
    # Note that $mat{$x}{$y} denotes the distance between the 
    # substrings 1..$x and 1..$y
    #
    return $mat{$len1}{$len2};
}


# minimal element of a list
#
sub min
{
    my @list = @{$_[0]};
    my $min = $list[0];

    foreach my $i (@list)
    {
        $min = $i if ($i < $min);
    }

    return $min;
}

#######################################
#######################################
#######################################

my $iterator = File::Next::files($inDir);
my $xml = new XML::Simple;

system("mkdir -vp $tmp_dir");
open (GSFILE, '>', "$tmp_dir/$gs");
print GSFILE "load $ismeFile\n"."apply up < $tmp_dir/in\.gtest\n"."quit\n"; 
close GSFILE;

open (LSFILE, '>', "$tmp_dir/levenshtein_file.txt");

init_dep();

while ( defined ( my $inFile = $iterator->() ) ) {
  print $inFile, "\n";
  if($inFile =~ /\.dep$/) {
    my ($cf) = $inFile =~ /(.*)\.dep$/; 
    my $c_plx = $cf."\.xml";
    my $c_vrt = $cf."\.xml";
    if(-f $c_plx) {
      my $cDir = dirname($inFile);
      my ($cPath) = $c_plx =~ /^$rootDir\/(.*)$/;
      $cDir= "$outDir/$cDir";
      make_path($cDir);
      my $outFile = "$outDir/$c_vrt";
      #my $out_metaFile = "$outDir/$cf.meta";
      #print("_xfilex_ $new_location");
      #copy($c_plx,$new_location) or die "Copy failed: $!";
      
      open (OUTFILE, '>', "$outFile");
      open (INFILE,"$inFile") || die "Can't Open File: $inFile\n";
      # open (OUTMETAFILE, '>', "$out_metaFile");      

      # read metadata
      my $m_data = $xml->XMLin($c_plx,
			       ForceArray => 1,
			       # ForceContent => 1,
			       SuppressEmpty=>'',
			       KeyAttr    => {},
			      );
      my $title = $m_data->{header}[0]{title}[0];
      if ($title eq "") {
	$title = "___";
      }
      my $genre = $m_data->{header}[0]{genre}[0]{code};
      if ($genre eq "") {
	$genre = "___";
      }
      my $translated_from = $m_data->{header}[0]{translated_from}[0]{'xml:lang'};
      if ($translated_from eq "") {
	$translated_from = "___";
      }
      my $fname = $m_data->{header}[0]{author}[0]{person}[0]{firstname};
      if ($fname eq "") {
	$fname = "___";
      }
      my $lname = $m_data->{header}[0]{author}[0]{person}[0]{lastname};
      if ($lname eq "") {
	$lname = "___";
      }
      my $nationality = $m_data->{header}[0]{author}[0]{person}[0]{nationality};
      if ($nationality eq "") {
	$nationality = "___";
      }
      my $year = $m_data->{header}[0]{year}[0];
      if ($year eq "") {
	$year = "___";
      }

      $title = unhtmlize($title);
      $genre = unhtmlize($genre);
      $translated_from = unhtmlize($translated_from);
      $fname = unhtmlize($fname);
      $lname = unhtmlize($lname);
      $nationality = unhtmlize($nationality);
      $year = unhtmlize($year);
      
#       # print output
#       print "===========================";
# #      print OUTMETAFILE Dumper($year);
#       print OUTMETAFILE $title;
#       print OUTMETAFILE $genre;
#       print OUTMETAFILE $translated_from;
#       print OUTMETAFILE $fname;
#       print OUTMETAFILE $lname;
#       print OUTMETAFILE $year;
#       print "===========================";

      # from cwb-encode -h 
      #  -U <str>  insert <str> for missing columns [default: "___"]
      
      print OUTFILE '<?xml version="1.0" encoding="UTF-8"?>';
      print OUTFILE '<text title="'.$title.'" lang="'.$lang.'" orig_lang="'.$translated_from.'" gt_domain="'.$domain_map{$genre}.'" first_name="'.$fname.'" last_name="'.$lname.'" nationality="'.$nationality.'" year="'.$year.'" path="'.$cPath.'">';
      print OUTFILE '  <sentence id="'.$sentCounter.'">';
      
      while (<INFILE>) {
	# next if $_ eq '';
        chomp;
        if (/^\"</) { #new lemma
	  print "new Lemma: $_\n";
	  ($word) = $_ =~ /<(.+)>/;
	  $word =~ s/_/ /g;
	  $newCohort = 1;
	  $firstLine = 1;
        }
	#        else { #no new lemma
	elsif (/^\t+(\".*www\..*\")(.*Adv.*)$/) { #analysis www AND adv
	    next;
	}
	elsif (/^\t+(\"[^\"]+\")(.*)$/) { #analysis
	  if ($firstLine) {
	    $firstLine=0;
	    $lemma = lemma_trim($1);
	    $analysis = trim($2);
	    
	    $lemma = unhtmlize($lemma);
	    $word = unhtmlize($word);
	    
	    ($pos,$msd,$sID,$pID,$depRel,$isDer) = get_msd(trim($2));
	    
	    $depRel = $dep_rel{$depRel};
	    if ($depRel eq "" || $depRel eq "\?")  {
	      $depRel = "X";
	    }
	    
	    $pos = unhtmlize($pos);
	    # store initial lemma value temporarily in case the generation of correct derivation lemma results into '???'
	    $tmpLemma = $lemma;
	    
	    # get real lemma of the POS* item
	    if ($isDer eq "ye") {
	      $lemma = $realLemma;
	      # - interim solution until the pipeline will be changed
	      # in order to get all derivation lemmata correctly;
	      # - the problem is lookup2cg, which changes the output of the analysis
	      # - restore the POS* values for lemma, pos, and msd
	      if ($lemma eq '???') {
		$lemma = $tmpLemma;
		$pos = $tmpPOS;
		$tmpMSD =~ s/^\s+//;
		$tmpMSD =~ s/\s+$//;
		$tmpMSD =~ s/ /\./g;
		$tmpMSD =~ s/\//_/g;
		$msd = $pos.'.'.$tmpMSD;
	      }
	    }
	    
	    if ($newCohort) {
	      print OUTFILE "    <w word=\"".$word."\" lemma=\"".$lemma."\" pos=\"".$pos."\" msd=\"".$msd."\" sID=\"".$sID."\" depRel=\"".$depRel."\" pID=\"".$pID."\"/>";
	    }
	    reset_var();
	  }
	  else { # not firstLine
	    #check www-pattern here
	    next;
 	  }
	} #analysis 
	else { #newline in the input => new sentence
	  print OUTFILE '  </sentence>';
	  $sentCounter++;
	  if (! eof)  { print OUTFILE '  <sentence id="'.$sentCounter.'">' }
	} #newline
	#} #else no new lemma
      } #while
      
      print OUTFILE '</text>';
      print "$inFile done!\n";
      close INFILE;
      close OUTFILE;
#      close OUTMETAFILE;
      $sentCounter = "1";
    }
    else {
      print STDERR "meta-file ".$c_plx." not found!\n";
    }
  }
}

#closedir(DIR);
exit 0;

