#!/usr/bin/perl
#----------------------------------------------------------------------------------
# MODE D EMPLOI : perl extract-relation-udpipe.pl nom_du_fichier_de_sortie.xml "obj"
# En entrée : sortie UDPIPE formatée en XML + une relation syntaxique
# En sortie la liste triée des couples Gouv,Dep en relation
#----------------------------------------------------------------------------------
use strict;
use utf8;
binmode STDOUT, ':utf8';
#-------------------------------------------------------------------------------------
#le fichier qu'on veut traiter
my $rep="$ARGV[0]";
#la relation de dépendance recherchée
my $relation="$ARGV[1]";
#dictionnaire des relations
my %dicoRelation=();
#-------------------------------------------------------------------------------------
# on découpe le texte par phrase (liste d'items annotés et potentiellement dépendants)
# arrêt sur les balises </p> 
$/="</p>"; 			
open my $IN ,"<:encoding(utf8)","$ARGV[0]";
#lecture des phrases
while (my $phrase=<$IN>) {
	#-------------------------------------------------------------------------------------
	# on traite chaque "paragraphe" en le decoupant "items"
	# on découpe les phrases en lignes, elles deviennent des listes 
	my @LIGNES=split(/\n/,$phrase);
	#parcourt de la liste, itération sur les indices de la liste. on commence à l'indice 0 et 
	#on s'arrêtera au dernier indice de la liste
	for (my $i=0;$i<=$#LIGNES;$i++) {
		# si la ligne lue contient la relation, on ira chercher le dep puis le gouv
		# on veut voir la ligne suit le pattern suivant: expression régulière qui décrit l'item
		#recherche la présence de obj
		if ($LIGNES[$i]=~/<item><a>([^<]+)<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>([^<]+)<\/a><a>[^<]*$relation[^<]*<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/i) {
			# si c'est le cas on veut la position du dépendant
			my $posDep=$1;
			# on veut la position du gouverneur 
			my $posGouv=$3;
			# on veut la position du dépendant
			my $formeDep=$2;
			# soit le gouv est avant le dep, soit après...
			if ($posDep > $posGouv) {
				#parcourir au début de cette liste entre l'indice 0 et l'indice du gouverneur
				for (my $k=0;$k<$i;$k++) {
					# la liste doit avoir ce pattern, avec dans le premier a la valeur de la position du gouverneur 
					if ($LIGNES[$k]=~/<item><a>$posGouv<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/) {
						#on récupère la forme et on stocke dans le dictionnaire
						my $formeGouv=$1;
						$dicoRelation{"$formeGouv $formeDep"}++;
					}
				}
			}
			else {
				#si gouverneur est après, on cherche dans la liste des lignes jusqu'à la fin
				for (my $k=$i+1;$k<=$#LIGNES;$k++) {
					if ($LIGNES[$k]=~/<item><a>$posGouv<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/) {
						my $formeGouv=$1;
						$dicoRelation{"$formeGouv $formeDep"}++;
					}
				}
			}
		}
	}
}
close ($IN);
# on imprime la liste des couples Gouv,Dep et leur fréquence...
foreach my $relation (sort {$dicoRelation{$b}<=>$dicoRelation{$a}} (keys %dicoRelation)) {
	print "$relation\t$dicoRelation{$relation}\n";
}
