﻿#!/usr/bin/perl
<<DOC; 
Charlène Denis et Larisa Nadel
JUIN 2012
Usage : perl programme_extraction_patrons.pl répertoire_fichiers_étiquetés.
Le programme prend en entrée le nom du répertoire contenant des fichiers étiquetés par Treetagger en format .xml .
L'utilisateur est demandé à fournir les patrons grammaticals soit en les fournissant dans la ligne de commande, soit en précisant le chemin vers un fichier avec un patron sur chaque ligne.
Le programme parcourt le répertoire d'entrée et répere les séquences des tokens qui correspondent aux patrons donnés par l'utilisateur.
En sortie, le programme crée un dossier RES_EXT_PATRON contenant pour chaque patron un fichier avec des sequences des tokens correspondantes. 
Dans cette variante du programme on utilise la bibliothèque Perl XML::XPath.
DOC

#-----------------------------------------------------------------

#On fait l'usage des bibliothèques XML::Xpath et Unicode::String
use XML::XPath;
use Unicode::String qw(utf8);

#-----------------------------------------------------------------

#On récupére le chemin vers le répertoire où se trouvent les fichiers 
my $rep=$ARGV[0];

#On crée le répertoire pour la sortie
mkdir ("RES_EXT_PATRON");

#On crée une liste vide pour les patrons
my @listedespatrons=();

my $encodage="utf-8";

#On demande l'utilisateur à fournir les patrons à trouver
print "Donnez le patron ou le nom du fichier contenant le patron\n";
my $response = <STDIN>;

#Si l'utilisateur a tapé un nom du fichier txt,
if ($response=~/\.txt$/) { 

	chomp($response);
	#on ouvre ce ficher en mode de lecture...
	open (FILE, "<:encoding($encodage)",$response) or die "can't open $response: $!\n";

	#on le lit ligne par ligne (toujours en espère que chaque ligne du fichier porte un seul patron)
	while (my $patron = <FILE>) {
		chomp($patron);

		#On stocke chaque patron dans la liste des patrons
		push(@listedespatrons, $patron);
			}
		}

#Si l'utilisateur a tapé autre chose, on suppose que c'est un patron
else {
	chomp($response);

	#On garde ce patron dans la liste
	push(@listedespatrons, $response);}

#A ce niveau là on dispose d'une liste des patrons contenant soit un motif donnée par l'utilisateur directement, soit un ou plusieurs motifs lus dans le fichier

#On lance la fonction de parcours
&parcoursarborescencefichiers($rep);

#On utilise encore une fois cette fonction de parcours d'arborescence des fichiers... Maintenant, c'est pour récupérer les la sortie de BaO2!!!
sub parcoursarborescencefichiers {
	my $path = shift(@_);
    	opendir(DIR, $path) or die "can't open $path: $!\n";
    	my @files = readdir(DIR);	
    	closedir(DIR);	
    	foreach my $file (@files) {	
		next if $file =~ /^\.\.?$/;	
		$file = $path."/".$file;	
		if (-d $file) {		
			&parcoursarborescencefichiers($file);	
	}
		if (-f $file) {	

			#Si le nom du fichier se termine par ttg.xml, on lance la fonction d'extraction de patron pour la sortie de Treetagger
			#if ($file=~/\.cnr$/) {&ch_patron_rgxp($file);}
			if ($file=~/ttg\.xml$/) {print "traitement de $file \n"; 

			foreach my $pattern (@listedespatrons) {&extract_pattern($pattern, $file);}
			}
		}
	}
}

#La logique d'extraction du motif par la bibliothèque XML::XPath n'est pas pareille à celle du méthode d'expressions regulières.
#Ici, D'ABORD, on construit une requete xPath qui trouve un élement qui correspond à la 1re cathégorie du patron et DONT les frères suivants correspondent à la suite du patron. PUIS, on utilise des méthodes de la bibliotèque pour récupérer ce 1r élément et ses frères. 

# routine de construction des chemins XPath fournie par RB
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 éveltuel 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é
	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é 
	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;
	while ($i < $#tokens) {print $i."\n";
		$search_path.="[ancestor::element/following-sibling::element[$i]/data[\@type=\"type\"][contains(text(),\"$tokens[$i]\")]";
		$i++;
	}
	my $j=$i-1;
	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
	$search_path.="[ancestor::element/following-sibling::element[$#tokens]/data[\@type=\"type\"][contains(text(),\"".$tokens[$#tokens]."\")]]"
								.$search_path_suffix;
	print $search_path."\n";

	# on renvoie à la procédure appelante le chemin XPath et le tableau des éléments du motif
	#print $search_path."\n";
	return ($search_path,@tokens);

}

# routine d'extraction du motif
sub extract_pattern{
	# On récupère la ligne du motif recherché
	my $patron= shift @_;
	my $tag_file= shift @_;
	#foreach my $patron (@listepat) {

	# Appel de la fonction construit_XPath pour le motif lu à la ligne courrante du fichier de motif
	my ($search_path,@tokens) = &construit_XPath($patron);
	
	# définition du nom du fichier de résultats pour le motif en utilisant la fonction join
	my $match_file = "./RES_EXT_PATRON/res_ttg_".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 la variable de travail $noeud_suivant
		# cette variable va subir les modification 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) {
           	 $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_elmt, $noeud_suivant)->get_nodelist();
           
            # récupération du noeud recherché
            	$noeud_suivant=shift(@noeuds_suivants);
           
            # impression de la forme 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);
#}
}
exit;
