﻿#!/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 Cordial en format .cnr.
L'utilisateur est amené à fournir les patrons grammaticaux 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épère 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 séquences de tokens correspondantes. 
Dans cette variante du programme, on n'utilise que le module standart des expressions régulières Perl.
DOC

#-----------------------------------------------------------------

#On reste toujours avec la bibliothèque Unicode::String
use Unicode::String qw(utf8);

#-----------------------------------------------------------------

#On récupère le chemin vers le répertoire dans lequel les fichiers se trouvent
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 de 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èrant que chaque ligne du fichier porte un seul patron)
	while (<FILE>) {
		chomp($_);
		print $_."\n";

		#On stocke chaque patron dans la liste des patrons
		push(@listedespatrons, $_);
		}
		close (FILE);
	}
#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é 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 sorties de la BàO 2 !
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 fichier est au format de cnr, on lance la fonction d'extraction de patrons pour la sortie de Cordial
			if ($file=~/\.cnr$/) {&ch_patron_rgxp($file);}
			#elsif ($file=~/\.ttg\.xml$/) {&ch_patron_xpath($file);}
		}
	}
}

#La fonction est initialisée
sub ch_patron_rgxp {

#On crée trois listes vides pour les lemmes, les formes et les catégories qu'on va extraire du fichier
my @listedetokens = ();
my @listedelemmes = ();
my @listedepos = ();

#On récupère le nom du fichier passé à la fonction
my $file=shift(@_);

#Et on ouvre ce fichier
open (FICTAG, "<:encoding(iso-8859-1)", $file);

#On le lit ligne par ligne
while (my $ligne=<FICTAG>) {
    #----------------------------------------------------------------------------------
    #On ne s'occupe pas des lignes qui ne respectent pas le modèle mot tab mot tab mot
    #----------------------------------------------------------------------------------
    if ($ligne =~ /(.+?)\t(.+?)\t(.+?$)/) {
	#-------------------------------------------
	#On supprime le retour à la ligne éventuel
	chomp($ligne);	
	#-------------------------------------------
	#On divise chaque ligne par une tabulation
	my @malignesegmentee = split(/\t/, $ligne);

	#Et on stocke le lemme, la forme et la catégorie chacun dans sa liste correspondante
	push(@listedetokens, $malignesegmentee[0]);
	push(@listedelemmes, $malignesegmentee[1]);
	push(@listedepos, $malignesegmentee[2]);
	#-------------------------------------------
    }
}

#On ferme le fichier d'étiquetage
close(FICTAG);

#On crée une copie de la liste des catégories
my @tmplistedespos=@listedepos;

#On initialise un compteur des éléments du patron
my $indice=0;

#La fonction shift() garde le premier élément de la liste et en même temps, supprime cet élément de la liste
#On épuise la liste grâce à cette fonction appelée dans la boucle while 

#A chaque fois qu'on a récupéré une catégorie,
while (my $a =shift(@tmplistedespos)) {

	#On commence à tester sa compatibilité avec tous les patrons de la liste de patrons
	foreach my $patron (@listedespatrons) {

	#On segmente le patron pour connaître son premier élément
	my @listedeterme=split(/\#/,$patron);

	#On teste si l'élément courant POS correspond au premier élément du patron...
	#Si c'est OK, on regarde s'il y a correspondance pour la suite...
	if ($a=~/$listedeterme[0]/) {

		#On initialise un compteur pour le nombre de coïncidences
		my $verif=0;

		#Lorsque le compteur $i est inférieur à la longueur du patron,
		for (my $i=0;$i<=$#listedeterme-1;$i++) {

			#On vérifie la correspondence entre les éléments suivants des deux listes
			#Par exemple, si le patron a deux éléments (e.g. PRP NOM), il nous reste une seule correspondance des deux à vérifier
			#Pourquoi dans la liste $tmplistedespos commence-t-on par le 1er élément (soit $i=0) ? Parce que l'élément précedent le premier qui a trouvé sa correspondance avec le patron est déjà supprimé par shift() !!!
			if ($tmplistedespos[$i]=~/$listedeterme[$i+1]/) { 

			#Si le suivant a été bon, on augmente le compteur de $verif
			$verif++ ;
			}
		}

		#Si verif est égal au nombre d'éléments du patron c'est qu'on a tout reconnu... 
		#On imprime les tokens en parallèle aux POS : astuce $indice permet de garder la correspondence entre POS et TOKEN....

		if ($verif == $#listedeterme) { 

		#On crée une copie du nom du patron pour appeler un fichier de sortie
		my $nom_patron=$patron;

		#On y supprime tous les caractères qui ne peuvent pas s'utiliser pour les noms des fichiers
		$nom_patron=~s/[^a-zA-Z#]//g;

		#Et on remplace le # par un défit bas
		$nom_patron=~s/#/_/g;

		#On ouvre le fichier de sortie individuelle pour chaque patron
		open (RES, ">>:encoding($encodage)", "./RES_EXT_PATRON/res_cord_$nom_patron.txt");

		#print "Correspondance sur $patron \n";
		for (my $i=0;$i<=$#listedeterme;$i++) {
		print RES $listedetokens[$indice+$i]," ";
		}
		print RES "\n";
		}
	}
}
    #On avance dans la liste des POS et des TOKEN en parallèle
    $indice++;

}
}


