#/usr/bin/perl
<<DOC; 
////////////////////////////////////////////////////////////////////////////////////////////////////////
//                                                                                                    //
//  Nom : Hayoung SEO                                                                                 //
//  Date : Avril 2021                                                                                 //      
//  But : Extraire les patrons morphosyntaxiques       												  //
//  Entrée : 1. fichier udpipe au format txt obtenu avec bao2                                 	      //
//           2. fichier patron au format txt            											  //
//  Sortie : Fichier au format txt                                       							  //
//  Usage : perl bao3_extraction.pl fichier_udpipe fichier_patron                                     // 
//  Exemple d'usage : perl bao3_extraction.pl sortie_udpipe.txt patron.txt 							  //      
//                                                                                                    //
////////////////////////////////////////////////////////////////////////////////////////////////////////
DOC
#-----------------------------------------------------------
# Ouverture des fichiers 
open my $entree, "$ARGV[0]";
open my $termino, "$ARGV[1]";
@patrons=<$termino>;
close $termino;

#open my $entree, "$ARGV[0]";
#-----------------------------------------------------------
# création des listes vides 
@pos=();
@token=();
#-----------------------------------------------------------
while (my $ligne=<$entree>) {
	# s'il commence par dièse ou s'il contient deux chiffres comme 4-5 
	# on ignore 
	next if $ligne=~m/^#|\d+\-\d+/ ;
	$ligne=~s/\r?\n//g;
	# si la ligne n'est pas vide 
	if ($ligne ne "") {
	my @ligne = split(/\t/, $ligne); # car le résultat de udpipe est séparé par tabulation \t
	push @pos, $ligne[3];  # $ligne[3] == pos 
	push @token, $ligne[1]; # $ligne[1] == token 
	#my $rep=<STDIN>;
	}
	# si la ligne est vide = fin de mon paragraphe 
	else {
	foreach my $suitedepos (@patrons) {
		$long=0;
		$suitedepos=~s/\r?\n//g;
		while ($suitedepos=~/ /g) {$long++}
		$i=0;
		foreach my $element (@pos) {
			$i++;
			if ($suitedepos =~/^$element/) {
			$suite="";		
			for ($j=$i-1;$j<=$long+$i-1;$j++) {$suite=$suite.$pos[$j]." "}
			if ($suite=~/$suitedepos/) {
				$extract = join(" ", @token[$i-1..$j-1]);
				$dict{lc($extract)}++;
				print "$extract\n";
					}
				}
			}
		}
	@pos=();
	@token=();
	}
}