#!/usr/bin/perl
#----------------------------------------------------------------------------------
# MODE D EMPLOI : 
# On se position sur le répertoire BAO3, puis lancer : 
# 	perl bao3-extract-terminologie-udpipe.pl fichierudpipe ficherpatron
# En entrée : le fichier étiqueté par udpipe au format text + le ficihier contenant les patrons à extraire
# En sortie les résultats d'extraction au format text
#----------------------------------------------------------------------------------
use utf8;
use Timer::Simple ();
#----------------------------------------------------------------------------------
# Ouverture des fichiers en lecture
#----------------------------------------------------------------------------------
open my $fichierud, "$ARGV[0]" or die ("probleme sur ouverture de la sortie Udpipe...");
open my $fichierpos, "$ARGV[1]" or die ("probleme sur ouverture du fichier des patrons...");
#open (FICTAG, $ARGV[0]) or die ("probleme sur ouverture de la sortie Udpipe...");
#open (FICPOS, $ARGV[1]) or die ("probleme sur ouverture du fichier des patrons...");
#----------------------------------------------------------------------------------
# on stocke les patrons dans une liste
#----------------------------------------------------------------------------------
my @listedespatrons=();
while (my $lignepos = <$fichierpos>) {
    chomp($lignepos);
    push(@listedespatrons,$lignepos);
}
close $fichierpos;
#----------------------------------------------------------------------------------
# Initialisation des listes
#----------------------------------------------------------------------------------
my @malignesegmentee = ();
my @listedesindexs=();
my @listedetokens = ();
my @listedelemmes = ();
my @listedepos = ();
#----------------------------------------------------------------------------------
# Lecture du fichier de tags ligne par ligne
#----------------------------------------------------------------------------------

while (my $ligne = <$fichierud>) {
    #----------------------------------------------------------------------------------
    # On ne s'occupe pas des lignes qui ne respectent pas la modèle mot tab mot tab mot
    #----------------------------------------------------------------------------------
    if ($ligne =~ /^([0-9]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)$/) 
    {
		#-------------------------------------------
		# Suppression du caractère de saut de ligne
		chomp($ligne);
		#-------------------------------------------
		# Remplissage des listes
		@malignesegmentee = split(/\t/, $ligne);
		push(@listedesindexs, $malignesegmentee[0]);
		push(@listedetokens, $malignesegmentee[1]);
		push(@listedelemmes, $malignesegmentee[2]);
		push(@listedepos, $malignesegmentee[3]);
	#-------------------------------------------
    }
}
close $fichierud;
#-----------------------------------
# on va maintenant parcourir les POS
# et les TOKENS en //
#----------------------------------------------------------------------------------------
# 1. on cree une liste tmp des POS que l'on va parcourir en supprimant le premier element 
#    a chaque fois
#----------------------------------------------------------------------------------------
my @tmplistedespos=@listedepos;
my $indice=0;
# shift recupère le premier élément de la liste et supprime celui-ci de la liste également.
while (my $POS =shift(@tmplistedespos)) {
    foreach my $patron (@listedespatrons) {
		#-----------------------------------
		# on segmente le patron pour connaitre
		# son premier element
		my @listedeterme=split(/ /,$patron);
		#-----------------------------------
		# on teste si l'element courant POS correspond au premier element du patron...
		if ($POS eq $listedeterme[0]) {
			# si oui on regarde maintenant s'il y a correspondance pour la suite...
			my $verif=0;
			for (my $i=0;$i<=$#listedeterme-1;$i++) {
				if (($tmplistedespos[$i] eq $listedeterme[$i+1]) and ($listedesindexs[$i+1] >= $listedesindexs[$i] )) { 
					#Le suivant est bon aussi...
					$verif++ ;
				}
				else {
				# ici : $tmplistedespos[$i] differe de $listedeterme[$i+1]...
				}
			}
			#------------------------------------------------------------------------
			# si verif est egal au nb d'element du patron c'est qu'on a tt reconnu... 
			# on imprime les tokens en // aux POS : astuce $indice permet de garder le 
			# le // entre POS et TOKEN....
			#------------------------------------------------------------------------
			if ($verif == $#listedeterme) { 
				print "$patron\t";
				for (my $i=0;$i<=$#listedeterme;$i++) {
					print $listedetokens[$indice+$i]," ";
				}
				print "\n";
			}
		}
    }
	my $tmp=shift(@listedesindexs);
    $indice++;
    # on avance dans la liste des index, des POS et des TOKEN en //
}