#!usr/bin/perl

<<DOC;
Noélie BOTTERO & Yimina
Projet encadré 2 2020 - 2021
BAO3 - extraction de patrons morpho-syntaxiques Udpipe
Ce programme extrait des patrons morpho-syntaxiques
dans les étiquetages produits avec UDpipe dans la BAO2.
Commande : perl BAO3-udpipe.pl 	FICHIER-A-TRAITER 	PATRON

PATRONS : 
- NOM PREP NOM PREP
- VERBE DET NOM
- NOM ADJ
- ADJ NOM
- PROPN VERBE ADJ
- ADJ ADP NOUN

DOC

# Ouverture du fichier Udpipe
open my $termino, "$ARGV[1]";
@patrons=<$termino>;
close $termino;
#my $suitedepos="VERB DET NOUN";
open my $entree, "$ARGV[0]";
open my $output, ">:encoding(UTF-8)","sortie-extraction-udpipe-tech.txt";
@pos=();
@token=();

while (my $ligne=<$entree>) {

	next if $ligne=~m/^#|\d+-\d+/ ;
	# pour éviter les phrases qui correspondent à la contraction de du ou des
	$ligne=~s/\r?\n//g;
	if ($ligne ne "") {
	my @ligne = split /\t/, $ligne;
	push @pos, $ligne[3];
	push @token, $ligne[1];
	#my $rep=<STDIN>;
	}
	
	else {

	foreach my $suitedepos (@patrons) {
		# print $output "$suitedepos\n";
		$long=0;
		$suitedepos=~s/\r?\n//g;
		while ($suitedepos=~/ /g) {$long++}
		$i=0;
		# on se fie à l'indice, garde en mémoire la liste de pos donné par l'utilisateur
		# s'il y a une correspondance, on extrait
		
		foreach my $element (@pos) {
			$i++;
			if ($suitedepos =~/^$element/) {
			# print "presence de $element, je cherche toute la séquence de $i et ensuite sur $long caractères\n";
			$suite="";		
			for ($j=$i-1;$j<=$long+$i-1;$j++) {$suite=$suite.$pos[$j]." "}
			# print "$suite\n";
			# print $output "==>$suitedepos<==\n";

			if ($suite=~/$suitedepos/) {
				print "MATCH de $i à $j\n";
				print "@token[$i-1..$j-1]\n";
				$extract = join(" ", @token[$i-1..$j-1]);
				# print $output "$extract\n";
				# création d'un hash, on dt à perl de mettre en minuscule chacune des extractions
				$dict{lc($extract)}++;
				print $output "$suite\n";
				print $output "$extract\n";
				
				
					}
				}
			}
		}
	#my $rep=<STDIN>;
	@pos=();
	@token=();
	}
}

print $output "\n\n";
print $output "Occurrences de chaque segment :\n";

foreach my $result (keys %dict){
	printf $output "%-8s %s\n",$result,$dict{$result};
}