#!/usr/bin/perl

# Utilisation : perl patrons_jmd.pl fichier_étiqueté fichier_patrons

# On ouvre le fichier d'entrée taggé avec Cordial et on crée un fichier de sortie qui contiendra les patrons extraits.
open(IN,"<:encoding(iso-8859-15)",$ARGV[0]) or die "Echec lors de l'ouverture du fichier : $!";
my $sortie="sortie_patrons_cordial_jmd.txt";
open(OUT,">:encoding(iso-8859-1)",$sortie) or die "Echec lors de l'ouverture du fichier : $!";   

my @token=();
my @lemme=();
my @pos=();

# On lit le fichier d'entrée ligne par ligne :
while(my $ligne=<IN>) {
	chomp $ligne;
	$ligne=~s/\r//g;
	my @liste=split(/\t/,$ligne);
	if (@liste==3) { # Si la ligne contient bien un token, un lemme et une POS, on les met dans des listes.
		push(@token,$liste[0]." ");
		push(@lemme,$liste[1]." ");
		push(@pos,$liste[2]." ");
	}
}

my $i=0;
my $j=0;

@phrase=();
while(defined($element_pos=shift(@pos))) {
 	$element_pos=~s/\n//;
 	if ($element_pos!~"PCTFORTE") { # Tant qu'on parcourt les éléments sans trouver de ponctuation forte, on les met dans une liste @phrase
 		push(@phrase,$element_pos);
 		$i++;
 	}
 	else { # Quand on trouve une PCTFORTE, on a une "phrase" de POS, et on lance la procédure &cherche_patron sur cette phrase
	&cherche_patron(@phrase);
	#print "__________________\n";
	@phrase=();
	$j=$i+1;
	$i++;
	}
}

##################################################################################################

sub cherche_patron {
	my @phrase=@_;
	my $suite_pos=join("",@phrase);
	$suite_pos=~s/  / /g;
	$suite_pos=~s/^\s+//; 
	#print "$suite_pos\n";
	my $z=0;
	open(PATRON,$ARGV[1]);
	while(my $patron=<PATRON>) { # On parcourt la liste de patrons du fichier de patrons
		my $nb=1;
		chomp $patron;
		while ($patron=~m/ /g) {$nb++}; # On compte le nombre d'items du patron
		#print "On traite le patron : $patron\n";
		while ($suite_pos=~m/$patron/g) { # Si le patron est trouvé dans la suite de POS de la "phrase", on va chercher les tokens correspondant aux POS.
			#print "On a trouvé le patron !\n";
			my $avant=substr($suite_pos,0,pos($suite_pos)-length($&));
			while ($avant=~m/ /g) {$z++};
			print OUT "@token[$j+$z..$j+$z+$nb-1]\n";
			$z=0;
		}
	}
}