#!/usr/bin/perl

use POSIX qw(locale_h);

setlocale(LC_CTYPE, "pt_PT");

use locale;

use warnings;
use strict;

use Data::Dumper;

use NAT::Client;
use NAT::Matrix;
use NAT::PatternRules;

my ($rules, $dic, $f1, $f2) = @ARGV;

$/ = "</ua>\n";

open F1, $f1 or die $!;
open F2, $f2 or die $!;

my ($l1, $l2);

$rules     = NAT::PatternRules->parseFile($rules);
my $client = NAT::Client->new(localDumper => $dic);

while ($l1 = <F1>) {
  $l2 = <F2>;

  my ($left, $right) = ($l1,$l2);


  $l1 =~ s!<notetrad.*</notetrad>!!gs;
  $l2 =~ s!<notetrad.*</notetrad>!!gs;


  $l1 =~ s/^<.*$//mg;
  $l2 =~ s/^<.*$//mg;
  $l1 =~ s/\n+/\n/g;
  $l2 =~ s/\n+/\n/g;
  $l1 =~ s/^\n//g;
  $l2 =~ s/^\n//g;

  my @w1 = map { my @a = split /\s+/; $a[0] } split /\n/, $l1;
  my @w2 = map { my @a = split /\s+/; $a[0] } split /\n/, $l2;

  my $matrix = NAT::Matrix->new($client,$rules,\@w1,\@w2);
  $matrix->findDiagonal;
  my $blocks = $matrix->grep_blocks;
  my $bs = $matrix->combine_blocks($blocks, 1);

  my @blocks;
  for my $b (@$bs) {
    push @blocks, $matrix->dump_block($b);
  }

  my $CB = shift @blocks;
  for my $linha (split /\n/, $left) {
    if ($linha =~ m!^<!) {
      print "$linha\n"
    } else {
      $linha =~ m!^(\S+)\s!;
      my $word = $1;
      until (!@blocks || $CB->[0] =~ m!\b\Q$word\E\b!i) {
	# print "** WARNING ** >$CB->[0]< e >$word< nao fazem matching...\n";
	$CB = shift @blocks;
      }
      print "$linha\t$CB->[1]\n"
    }
  }
}