$\ = "\n"; $, = "\t";
use XML::LibXML;

binmode( STDOUT, ":utf8" );

open FILE, "/var/www/html/teitok/egpa/Scripts/diccionario.vrt";
binmode( FILE, ":utf8" );
while ( <FILE> ) {	
	chop;
	if ( /^<.*id="(.*?)".*lang="(.*?)"/ ) { $id = $1; $lang= $2; next; };
	if ( /^<.*/ ) { next; };
	( $form, $wid, $nform ) = split ( "\t" );
	if ( $form ne '' && $nform ne "--" ) {
		$reg{$lang}{$form}{$nform}++;
	};
};
close FILE;

$filename = shift;

if ( $filename eq '' ) {
	while ( ( $lang, $val ) = each ( %reg ) ) {
		while ( ( $form, $val2 ) = each ( %{$val} ) ) {
			while ( ( $nform, $num ) = each ( %{$val2} ) ) {
				print $lang, $form, $nform, $num;
	};};};
	exit;
};

$parser = XML::LibXML->new(); 
eval {
	$tmpdoc = $parser->load_xml(location => $filename, load_ext_dtd => 0);
};
if ( !$tmpdoc ) { print " - Unable to parse"; next; };
$tmpdoc->setEncoding('UTF-8');


# Verificación nform
my $contains_nform = 0;
foreach my $node ($tmpdoc->findnodes("//tok | //dtok")) {
    if ( $node->getAttribute('nform') ne '' ) {
        $contains_nform = 1;
        last;  # Si encontramos uno, no necesitamos seguir buscando
    }
}

# Detención del script
if ( $contains_nform ) {
    print "Se ha cancelado la ejecucion del script debido a que este archivo ya contiene datos referentes a la presentacion critica.";
    exit;
}

#@tmp = $tmpdoc->findnodes('//language');  $lang = $tmp[0]->getAttribute('subcat');
$lang = "ES";

print "Treating $filename - language: $lang";

foreach $node ($tmpdoc->findnodes("//tok")) {
	
	# ----- What Maarten did ----
	#$form = $node->getAttribute('form');
	#$id = $node->getAttribute('id');
	#if ( $form eq '' ) { $form = $node->textContent; };
	
	# ----- What GV edited (25/02/2020) ----
	# FROM HERE
	$form = $node->getAttribute('fform');
	$id = $node->getAttribute('id');
	if ( $form eq '' ) { $form = $node->getAttribute('form'); };
	if ( $form eq '' ) { $form = $node->textContent; };
	# TO HERE
	


	$onform = $node->getAttribute('nform');
	if ( $onform eq '' ) { $onform = $node->getAttribute('fform'); };
	if ( $onform eq '' ) { $onform = $node->getAttribute('form'); };
	if ( $onform eq '' ) { $onform = $node->textContent; };

	# print $id, $form;
	
	#if ( $reg{$lang}{$form} ) {
		$allnform = join ( "|", keys %{$reg{$lang}{$form}} );
		$m = 0; $nform = "";
		while ( ( $a, $b ) = each ( %{$reg{$lang}{$form}} ) ) {
			if ( $b > $m ) { $nform = $a; $m = $b; };
		};
		
		if ( $form eq '' ) { $yn = ""; $ignore++; } 
		elsif ( $onform eq $nform ) { $yn = '+'; $yes++; if ( $nform eq $form ) { $gmod++ }; } 
		elsif ( $nform eq '' ) { $yn = '?'; $uk++; }
		else { $yn = '-'; $no++; };
		
		if ( $nform eq $form ) { $nomod++ } else { 
			$mod++; 
			if ( $node->getAttribute('nform') eq '' && $node->getAttribute('fform') ne $nform ) {
				$node->setAttribute('nform', $nform);
			};
		};
		
		print $id, $form, $yn, $nform, $m, $onform, $allnform;
		

		
	#};
	
};
print "$yes good, $no bad, $uk new, $ignore empty";
print "$mod modernized, $nomod not, $gmod correctly modernized";

$text = $tmpdoc->toString; 

open FILE, ">$filename";
print FILE $text;
close FILE;
