#!/usr/bin/perl 

#----------------------------------
# EXTRACTION CORDIAL
# usage : extrac_cordial_bouclewhile.pl fichier.cnr liste_des_pos
# exemples : - extrac_cordial.pl fichier.cnr N V ADV
#			 - extrac_cordial.pl fichier.cnr N PREP N ADJ
#----------------------------------
#----------------------------------
# Récupération des catégories morphosyntaxiques entrés par l'utilisateur
my $sortie =""; # on prépare une variable pour le nom du fichier de sortie
for(my $n=1;$n<=$#ARGV;$n++){
	${"etiq$n"} = $ARGV[$n];
	$sortie .= ${"etiq$n"};
	$sortie .= "_";
}

#----------------------------------
# Ouverture du fichier en lecture
#----------------------------------
open (FICTAG, $ARGV[0]) or die ("probleme sur ouverture de la sortie CORDIAL...");

#---------------------------
# Initialisation des listes
#--------------------------
my @malignesegmentee = ();
my @listedetokens = ();
my @listedelemmes = ();
my @listedepos = ();

#-------------------------------------------
# Lecture du fichier de tags ligne par ligne
#-------------------------------------------
while (my $ligne = <FICTAG>) {
  
    #----------------------------------------------------------------------------------
    # On ne s'occupe pas des lignes qui ne respectent pas la modèle mot tab mot tab mot
    #----------------------------------------------------------------------------------
    if ($ligne =~ /^[^\t]+\t[^\t]+\t[^\t]+$/) {
	#-------------------------------------------
	# Suppression du caractère de saut de ligne
	chomp($ligne);

	#-------------------------------------------
	# Remplissage des listes
	@malignesegmentee = split(/\t/, $ligne);
	push(@listedetokens, $malignesegmentee[0]);
	push(@listedelemmes, $malignesegmentee[1]);
	push(@listedepos, $malignesegmentee[2]);
	#-------------------------------------------
    }
}
close(FICTAG);

my @listedepos2=();
my @listeindice=();
my @indice=();

#--------------------------------
# 1. on crée une nouvelle liste de pos, en collant à chaque pos la lettre 'z' et son indice dans la liste
#---------------------------------
my $i=0;
foreach my $pos(@listedepos){
	$pos.=z.$i;
	push(@listedepos2, $pos);
	$i++;
}

#----------------------------------
# 2. on transforme la liste précédente en une string, chaque élément étant séparé par des z (z est un bon séparateur car aucun pos ne contient cette lettre)
#----------------------------------
my $string=join(z,@listedepos2);

#-----------------------------------
# 3. j'écris la regexp pour récupérer une liste qui ne contiendra que les indices correspondant aux pos recherchés. A noter, l'utilisation du quantificateur non gourmand '?', indispensable pour filtrer la sous-chaîne la plus courte entre le nom de la catégorie grammaticale et l'indice.
#-----------------------------------
my $er ="";
for(my $c = 1;$c <= $#ARGV; $c++){
	$temp = ${"etiq$c"};
	$er.=" $temp [^z]*?z([0-9]+)z";
}
$er=~s/ //g;

# L'idée est de mettre tous ces indices dans une liste. Comme l'on est en "contexte de chaîne", le filtrage ci-dessous va renvoyer la liste des sous-chaînes filtrées par les sous-motifs qui correspondent aux expressions parenthésées.
@indice=($string=~m/$er/g);

#-----------------------------------
# 4. on utilise mes indices pour récupérer directement les tokens correspondant... en fait on produit des sous-tableaux de la longueur du patron et on les imprime
#------------------------------------
my $fin = $#ARGV-1;

for(my $i=0;$i<=$#indice-2;$i=$i+$#ARGV){
	my $k=$indice[$i];
	my $m=$i+$fin;
	my $n=$indice[$m];
	open(OUT,">>:encoding(iso-8859-1)","./resultat_$sortie.txt"); # Avec les boucles imbriqués on est obligé d'ouvrir le fichier ici
	while ($k <= $n){
		print OUT "$listedetokens[$k]\t";
		$k++;
	}
	print OUT "\n";
	close(OUT);
}

