#/usr/bin/perl

<<DOC; 
 Francesca Ervas, Ardas Khalsa, Thomas Moraine
 Avril 2012
 Script de Rachid
 usage : perl solutionXPATH.pl fichier_tag fichier_motif
DOC

# On s'impose a declarer nos variables avant de les utiliser
use strict;

# On annonce au Perl parser de permettre l'utilisation de utf8 dans le programme
use utf8;

# Appel au module perl
use XML::XPath;

# Définition globale des encodages d'entrée STDIN et de sortie STDOUT du script à utf8
# binmode dit que tout va etre ecrit ou lu en mode binaire
# Ces lignes marche sur linux/mac et si le terminal est configure en utf8
binmode STDIN,  ':encoding(utf8)';
binmode STDOUT, ':encoding(utf8)';

# On vérifie le nombre d'arguments de l'appel au script ($0 : le nom du script)
# Le tableau ARGV = une variable reserve qui verifie la liste des arguments en ligne de commande
# $# donne l'indice du dernier element du tableau 
# On teste SI le nombre d'arguments est differents de 1 (2 arguments -> 0, 1)
if($#ARGV!=1){print "usage : /usr/local/ActivePerl-5.14/bin/perl $0 fichier_tag fichier_motif";exit;}

# Enregistrement des arguments de la ligne de commande dans les variables idoines
# La fonction shift envoie une valuer (le 1er element) qui est affecte a la variable tag_file, ensuite le 1er element est supprime du tableau ARGV
my $tag_file = shift @ARGV;
my $patterns_file = shift @ARGV;

# Ouverture du fichier de motifs (On aurait pu preciser l'encodage(utf8) ici au lieu d'en haut avec binmode)
open(PATTERNSFILE, $patterns_file) or die "can't open $patterns_file: $!\n";

# On parcourt le fichier (2eme argument en ligne de commande) contenant les motifs, un motif par ligne (par exemple : NOM ADJ) 
while (my $ligne = <PATTERNSFILE>) {
	# Appel à  la procédure d'extraction des motifs (On envoie la 1ere ligne par ex: NOM ADJ)
	&extract_pattern($ligne);
}

# Fermeture du fichier de motifs
close(PATTERNSFILE);

# Routine de construction des chemins XPath
sub construit_XPath{
	# On récupère la ligne du motif recherché
	my $local_ligne=shift @_;
	
	# Initialisation du chemin XPath
	my $search_path="";
	
	# On supprime avec la fonction chomp un éventuel retour à la ligne
	chomp($local_ligne);
	
	# On élimine un éventuel retour chariot hérité de Windows
	$local_ligne=~ s/\r$//;
	
	# Construction au moyen de la fonction split d'un tableau dont chaque élément a pour valeur un élément du motif recherché
	#Split agit sur une chaine de caractere par rapport a une expression reguliere, ici c'est un caractere separe par un espace unique
	my @tokens=split(/ /,$local_ligne);
	
	# On commence ici la construction du chemin XPath
	# Ce chemin correspond au premier noeud "element" de l'arbre XML qui répond au motif cherché 
	# On doit despecialise @ et les doubles cotes 
	my $search_path="//element[data[\@type=\"type\"][contains(text(),\"$tokens[0]\")]";
	
	# Initialisation du compteur pour la boucle de construction du chemin XPath
	my $i=1;
	# On regenere la requete XPATH automatiquement
	# Pourquoi $#?
	while ($i < $#tokens) {
		
		# On conserve les resultats du requete dans une variable
		# La requete: On veut se trouver dans ELEMENT, on va écrire un prédicat (tous les prédicats commencent par un crochet).  On veut la valeur d'une chaine de caractere (NOM PREP ADJ, par exemple) qui se trouve dans le texte.  le <data> qui contient cette valeur est le 1er fils de ELEMENT 
		$search_path.="[ancestor::element/following-sibling::element[1]/data[\@type=\"type\"][contains(text(),\"$tokens[$i]\")]";
		# Il compte le nombre d'elements dans tokens
		$i++;
	}
	my $j=$i-1;
	# On va ajouter un crochet fermant pour chaque nombre de patrons
	my $search_path_suffix="]";
	
	# On utilise l'opérateur x qui permet de répéter la chaine de caractère à sa gauche autant de fois que l'entier à sa droite,
	# Soit $i fois $search_path_suffix
	$search_path_suffix=$search_path_suffix x $i;
	
	# Le chemin XPath final
	# L'operateur . de concatenation
	$search_path.="[ancestor::element/following-sibling::element[1]/data[\@type=\"type\"][contains(text(),\"".$tokens[$#tokens]."\")]]"
								.$search_path_suffix;
	
	# On renvoie à la procédure appelante le chemin XPath et le tableau des éléments du motif
	return ($search_path,@tokens);
}

# Routine d'extraction du motif
sub extract_pattern{
	# On récupère la ligne du motif recherché (@_ stocke la liste de parametres qu'on a donne a la fonction, Ici c'est un parametre = $ligne avec le motif)
	my $ext_pat_ligne= shift @_;

	# Appel de la fonction construit_XPath pour le motif lu à la ligne courante du fichier de motif qui renvoie des valeurs a une liste, construit_XPath nous construit le chemin pour nous situer au debout du bloc (par exemple un NOM suivi d'un PREP)
	# my(liste) --> on definit une liste, le 1er element est stocke dans un scalaire, le 2eme un tableau qui contiendra les autres elements 
	my ($search_path,@tokens) = &construit_XPath($ext_pat_ligne);
	
	# Définition du nom du fichier de résultats pour le motif en utilisant la fonction join
	# join --> il reunit les differentes chaines d'une liste pour creer une seule chaine
	# On aura un fichier de sortie appele par exemple res_extract-NOM_ADJ.txt
	my $match_file = "res_extract-".join('_', @tokens).".txt";

	# Ouverture du fichiers de résultats encodé en UTF-8
	open(MATCHFILE,">:encoding(UTF-8)", "$match_file") or die "can't open $match_file: $!\n";
	
	# Création de l'objet XML::XPath pour explorer le fichier de sortie tree-tagger XML
	my $xp = XML::XPath->new( filename => $tag_file ) or die "big trouble";
	
	# Parcours des noeuds du ficher XML correspondant au motif avec le chemin XPath construit précédement
	# Avec la fonction construit_XPath
	foreach my $noeud ( $xp->findnodes($search_path)) {
		# Extraction impression de la forme correspondant au premier élément du motif
		print MATCHFILE $noeud->getChildNode(3)->string_value," ";
		
		# Copie de la variable de la boucle $noeud dans une variable de travail $noeud_suivant
		# Cette variable va subir les modifications nécessaires pour le calcul, on ne peut évidement pas modifier la variable de boucle
		my $noeud_suivant=$noeud;
		
		# Initialisation du compteur pour la boucle d'éxtraction des formes correspondants aux éléments suivants du motif
		my $following=0;
		
		# Boucle d'éxtraction des formes correspondants aux éléments suivants du motif
		# On descend graduellement au dernier noeud element
		while ( $following < $#tokens) {
			# On passe du 1er enfant au 2eme (ex: de NOM au PRP)
			$following++;
			
			# Construction du chemin XPath cible pour atteindre le noeud suivant
			my $following_elmt="./following-sibling::element[".$following."]";
			
			# La méthode "find" retourne un objet dont on peut extraire une liste de noeuds au moyen de la méthode get_nodelist,
			# Bien que cette liste, vu notre chemin, ne contient qu'un seul noeud (voir element[1])
			my @noeuds_suivants=$xp->find("./following-sibling::element[1]",$noeud_suivant)->get_nodelist();
			
			# Récupération du noeud recherché
			$noeud_suivant=shift(@noeuds_suivants);
			
			# Impression de la forme (le 3eme enfant) correspondant à l'élément suivant du motif au moyen de la méthode string_value
			print MATCHFILE $noeud_suivant->getChildNode(3)->string_value," ";
		}
		print MATCHFILE "\n";
	}
	# Fermeture du fichiers de motifs
	close(MATCHFILE);
}
