#!/usr/bin/perl

<<DOC;
prend en entrée un fichier issu de cordial
et un fichier de patrons morphosyntaxiques et
extrait suites de tokens correspondant aux patrons morpho-syntaxiques
DOC

print "bonjour\n";
open(FIC, $ARGV[0]) or die "impossible ouvrir $ARGV[0] : $!";
#$Argv[0] est le premier argument du programme (c'est à dire le fichier etiqueté cordial)
print "choisis nom de fichier pour contenir termes extraits\n";
my $fic=<STDIN>;
#<STDIN> input: range dans la variable fic la valeur qu'on lui donnera au clavier (equivalent d'un read fic dans d'autre langage)
open(FIC1, ">$fic");
#On ouvre le fichier en écriture. 
# chevron " >" pour ouvrir un fichier en ecriture; chevron "< "pour ouvrir en lecture (facultatif dans ce cas)
my $i=0;
my $j=0;
my $k=0;
my @token=();
while (<FIC>)
{
my $ligne=$_;
#variable par défaut $_ 
chomp $ligne;
my @liste=split(/\t/,$ligne);
#on construit un tableau à l'aide de la fonction split. On prend pour délimiteur \t -la tabulation-, car dans la sortie de cordial, la forme, le lemme et la catégorie sont séparés par une tabulation.
push(@token, $liste[$i++]." "); #$i++ prend la valeur de i puis l'incrémente de 1 (++$i incrémente dabord puis prend la valeur)
push(@lemme, $liste[$i++] ." ");
push(@patron, $liste[$i++] ." ");
#la fonction push range l'élément $liste[$i++] au fur et à mesure dans les tableaux. Elle prend en argument le nom du tableau dans lequel on veut rajouter les élements et le nom des élément qu'on veut ranger (on pourrait en avoir 10 à la suite si on voulait)
$i=0;
}
#on a 3 listes @token, @lemme, @patron
@sous_patron=();
while (defined($element_patron=shift(@patron))) #la fonction shift VIDE le premier élément de la liste @patron et le range dans la variable $element_patron.
#la fonction defined est une opération booléenne, elle retourne vrai si la variable a un contenu et faux si la variable n en a pas. Donc la boucle s'arretera quand la liste @patron sera entièrement vidée.
{
$element_patron=~s/\n//; #on supprime le \n
if ($element_patron !~ "PCTFORTE") 
#PCTFORTE désigne la ponctuation forte, etiquetée par cordial. On veut que l'élément soit différent de la ponctuation forte.
{
push(@sous_patron, $element_patron);
$j++;
next;
}

my @sous_token=@token[$k..$j-1]; 
# le crochet [x..y] signifie qu'on veut tous les éléments de l'element numero x à l'element numero y
&cherche_patron(@sous_patron);
@sous_patron=();
$k=$j+1;


$j++;
}
#=============================================
sub cherche_patron
{
my @liste=@_; 
#@_ contient la valeur de ce qu'on a mis en argument à la procédure, en l'occurence @sous_patron
my $suite_de_patrons=join("",@liste); 
#la fonction join transforme un tableau en chaine de caracteres. Elle prend en premier arg le séparateur que l'on veut, et en deuxieme argument le tableau .
#Ici, on prend la suite vide en séparateur car on a déja ajouter un espace plus haut entre les éléments du tableau.
$z=0;
$nb=0;
open(FIC, "$ARGV[1]");
# ARGV[1] est le fichier de patrons ( deuxieme argument du programme)
while(<FIC>)
{
$nb=0;
$ligne=$_;
chomp $ligne; 
#La fonction CHOMP enlève le retour charriot s'il y en a un. Attention, ne pas confondre avec la fonction CHOP qui enlève le dernier caractere de la ligne quel qu'il soit

while ($ligne=~m/ /g) {$nb++}; 
#=~m/ / meme chose que =~// : match: ce que l'on cherche
$nb++;
while ($suite_de_patrons=~m/$ligne/g) 
# le match regarde si la chaine contient le motif $ligne, il prend tout ce qu'il y a avant et s'arrette une fois qu'il a trouvé le motif, il ne prend rien après.
{
my $avant=substr ($suite_de_patrons, 0, pos($suite_de_patrons)-length($&)); 
#la fonction SUBSTR extrait une chaine de caractere. 
#La syntaxe est la suivante: SUBSTR(chaine dans laquelle on veut extraire, position à partir de laquelle on veut extraire, position jusqu'à laquelle on veut extraire)
#POS donne la position du premier caractère de la chaine; 
#LENGTH donne la longueur de la chaine; $& est une variable par defaut de perl, elle désigne le contenu du match (cf $1)
while ($avant=~m/ /g) {$z++};
print FIC1 "@token[$k+$z..$k+$z+$nb-1]\n";

$z=0;
}
}
}