#!/usr/bin/perl
<<DOC; 
Nom -- Elise LINCKER
Date -- AVRIL 2021

Traitement -- extraction des triplets (Antécédent Pronom Verbe) de relatives sujet
              antécédent -[acl:relcl]-> verbe -[nsubj]-> pronom[PronType=Rel]

Utilisation du programme -- perl bao3_extract_dep_relativesSujet_udpipexml.pl FICHIER_A_TRAITER
Exemple d'utilisation -- perl bao3_extract_dep_relativesSujet_udpipexml.pl BAO2_sortieUDpipe_3244.txt.xml > ./sorties_dep/BAO3_sortie_Perl_relativesSujet_3244.txt
Entrée -- le nom de la sortie UDPipe reformatée en XML
Sortie -- la liste triée des triplets GouvGouv Dep Gouv <=> Antécédent Pronom Verbe des relatives sujet

Remarque -- selon la relation à extraire, on voudra modifier l'ordre d'affichage des résultats (Dep Gouv ou Gouv Dep) lignes 58 et 67
DOC

use strict;
use utf8;
binmode STDOUT, ':utf8';

#---------------------------------------------------------------------------------
my $fichier="$ARGV[0]";
my %dicoRelation=();

#---------------------------------------------------------------------------------
#on découpe le texte par phrase (1 phrase par balise <p>)
$/="</p>"; 			
open my $IN ,"<:encoding(utf8)","$fichier";
while (my $phrase=<$IN>) {

	#-----------------------------------------------------------------------------
	# on transforme la phrase récupérée en une liste d'items : 1 ligne = 1 balise <item>
	#il suffit de segmenter les phrases avec le caractère de retour à la ligne car on a déjà 1 item par ligne dans le fichier
	my @LIGNES=split(/\n/,$phrase);

	#pour chaque ligne = item :
	for (my $i=0;$i<=$#LIGNES;$i++) {

		#on utilise les expressions régulières pour tester :
		#	si la 8e balise <a> contient la chaîne de caractères  'nsubj' (la relation qui gouverne le pronom)
		#	et la 6e balise <a> contient 'PronType=Rel' (il s'agit bien d'un pronom relatif)
		#et pour récupérer :
		#	dans la variable $formePronom la forme du pronom (le dépendant)
		#	dans la variable $positionPronom la position du pronom 
		#	dans la variable $positionGouv la position du gouverneur du pronom (verbe)
		if ($LIGNES[$i]=~/<item><a>([^<]+)<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]*PronType=Rel[^<]*<\/a><a>([^<]+)<\/a><a>[^<]*nsubj[^<]*<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/i) {
			my $formePronom=$2;
			my $positionPronom=$1;
			my $positionGouv=$3;

			#en fonction de la position du gouverneur par rapport au dépendant (avant ou après) 
			#on récupère dans la variable $formeGouv la forme du gouverneur
			#et dans la variable $positionGouvGouv l'identifiant du gouverneur du gouverneur (l'antécédent, le nom complété par la relative)
			
			#puis en fonction de la position du gouverneur du gouverneur par rapport au dépendant (avant ou après)
			#on récupère dans la variable $formeGouvGouv la forme du gouverneur du gouverneur

			#puis on ajoute à $dicoRelation la concaténation : forme de l'antécédent (GouvGouv) + espace + forme du pronom (Dep) + espace + forme du verbe (Gouv)

			if ($positionPronom > $positionGouv) {
				#si le gouverneur est avant le dépendant : on cherche le gouverneur parmi les lignes d'indice entre 0 et i
				for (my $k=0; $k<$i; $k++) {
					if ($LIGNES[$k]=~/<item><a>$positionGouv<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/) {
						my $formeGouv=$1;
						my $positionGouvGouv=$2;
						if ($positionPronom > $positionGouvGouv) {
							for (my $k=0; $k<$i; $k++) {
								if ($LIGNES[$k]=~/<item><a>$positionGouvGouv<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/) {
									my $formeGouvGouv=$1;
									$dicoRelation{"$formeGouvGouv $formePronom $formeGouv"}++;
								}
							}
						}
						else {
							for (my $k=$i+1; $k<=$#LIGNES; $k++) {
								if ($LIGNES[$k]=~/<item><a>$positionGouvGouv<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/) {
									my $formeGouvGouv=$1;
									$dicoRelation{"$formeGouvGouv $formePronom $formeGouv"}++;
								}
							}
						}
					}
				}
			}
			else {
				#si le gouverneur est après le dépendant : on cherche le gouverneur parmi la ligne d'indice i+1 et la fin de la liste
				for (my $k=$i+1; $k<=$#LIGNES; $k++) {
					if ($LIGNES[$k]=~/<item><a>$positionGouv<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/) {
						my $formeGouv=$1;
						my $positionGouvGouv=$2;
						if ($positionPronom > $positionGouvGouv) {
							for (my $k=0; $k<$i; $k++) {
								if ($LIGNES[$k]=~/<item><a>$positionGouvGouv<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/) {
									my $formeGouvGouv=$1;
									$dicoRelation{"$formeGouvGouv $formePronom $formeGouv"}++;
								}
							}
						}
						else {
							for (my $k=$i+1; $k<=$#LIGNES; $k++) {
								if ($LIGNES[$k]=~/<item><a>$positionGouvGouv<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/) {
									my $formeGouvGouv=$1;
									$dicoRelation{"$formeGouvGouv $formePronom $formeGouv"}++;
								}
							}
						}
					}
				}
			}
		}
	}
}
close ($IN);

#on affiche la liste des triplets GouvGouv, Dep, Gouv et leur nombre d'occurrences
foreach my $relation (sort {$dicoRelation{$b}<=>$dicoRelation{$a}} (keys %dicoRelation)) {
	print "$relation\t$dicoRelation{$relation}\n";
}