# Unify name tags
# <Larry> da <Silva> <Wall> X <John> S. <Doe>
# becomes
# <Larry da Silva Wall> X <John S. Doe>

use strict;
use warnings;
use diagnostics;
use Storable;

my $debug = 0;

$" = '';

if (@ARGV < 1) {
    print <<INFO
      Usage: perl $0 [dir]
      Where [dir] is the directory where the .ms files are located
INFO
;exit 1;
}

my ($dir) = @ARGV;

$dir ||= './';

open SW, "/matchsimile/stoplist";
my @stopwords = <SW>;
close SW;
@stopwords = map { split /\s/ } @stopwords;
my %stopword;
@stopword{@stopwords} = undef;

opendir DIR, $dir;
my @files = map { $dir.'/'.$_ } grep { /\.ms$/ } sort readdir(DIR);
closedir DIR;

undef $/;

my $caps =  qr/[A-ZÄÅÆÇÈÒÉÜÓÊÝÔËðÕÌßÖÍÎØÏÙÐþÚÑÛÀÁÂÃ]/;
my $texto = qr/[A-Za-zÄÅÆÇÈÒÉÜÓÊæÝÔËðçÞÕÌúñèßÖÍûòéàÎüóêáØÏýôëâÙÐþõìãÚÑÿöíäÛÀîåÁøïÂùÃ\s]+/;
my @buffer;

for my $file (@files) {
    @buffer = ();
    open IN, "< $file" or die "'$file' couldn't be opened";
    $_ = <IN>;
    close IN;
    open OUT, "> $file.new";
    my $aux = select(OUT);
    $|=1;
    select($aux);
    print STDERR "Processando $file\n";
    my $state = 'TEXT';
    my $total_size = length($_);
    s/(<[^>]*)<([^<>]*>)/$1$2/g; # <<foo> <bar> baz <quux>> vira <foo bar baz quux>
    study $_;
    /^/gc;
    my $tick = time;
    until(pos($_) == $total_size) {
	print STDERR sprintf "\r%10d bytes",$total_size - pos($_) if time > $tick && ($tick = time);
	if ($debug) {
	    print STDERR "[@buffer]";
	    print STDERR snippet(); print STDERR "\n";
	}
	if ($state eq 'TEXT') {
	    if (/\G(\s*<$caps[^<>]*>\s*)/gc) { $state = 'NAME'; push @buffer, $1; next; } 
	    if (/\G<([^<>]*)>/gc || /\G([^<>\s]*\s*)/gc)  { print OUT $1; next; }
	    die "STRANGE FOO ".snippet();
	} 
	if ($state eq 'NAME') {
	    if (/\G(<$caps[^<>]*>\s*)/gc) { push @buffer, $1; next } 
	    if (/\G<([^<>]*)>/gc)  { flush_name(); $state = 'TEXT'; print OUT $1; next; }
	    if (/\G(\s*([A-Z]\s*\.|(?!\s)$texto(?<!\s))\s*)/gc) {
		my ($token,$subtoken) = ($1,$2);
		if ($subtoken =~ /\b(?:x|e|ou)\b/i) { flush_name(); $state = 'TEXT'; print OUT $token; next; }
		$subtoken =~ tr/ÄÅÆÇÈÒÉÜÓÊæÝÔËðçÞÕÌúñèßÖÍûòéàÎüóêáØÏýôëâÙÐþõìãÚÑÿöíäÛÀîåÁøïÂùÃ/AAACEOEUOEaYOEecTOIunesOIuoeaIuoeaOIyoeaUEtoiaUNyoiaUAiaAoiAuA/;
		$subtoken =~ tr/A-Z/a-z/;
		if (length($subtoken) <= 2 || exists $stopword{$subtoken}) { push @buffer, $token; next; }
		flush_name(); $state = 'TEXT'; print OUT $token; next;
	    }
	    if (/\G([^<>\s]+\s*)/gc) {
		flush_name(); $state = 'TEXT'; print OUT $1; next;
	    }
	    
	    die "STRANGE FOO ".snippet();
	}
	die "STRANGE FOO ".snippet();
    }
    close OUT;
}
print STDERR "\n";
exit 0;

sub snippet {
    my $text = "{".substr($_,pos($_),42)."}";
    $text =~ s/[\r\n]/|/g;
    return $text;
}


sub flush_name {
    my $count = 0;
    for my $token (@buffer) {
	if ( index($token,'<') >= 0 ) {
	    if (++$count == 2) {
		my $buffer = "@buffer";
		$buffer =~ s/>([^<>]*)</$1/g;
		print OUT $buffer;
		@buffer = ();
		return;
	    }
	}
    }
    for my $tk (@buffer) {
	$tk =~ s/[<>]//g; 
	print OUT $tk;
    }
    @buffer = ();
    return;
}