#!/usr/bin/perl

<<DOC;
prend en entree un fichier issu de treetagger (argument en position 0)
et un fichier de patrons morphosyntaxiques (argument en position 1); 
le programme extrait des suites de tokens correspondant 
aux patrons morpho-syntaxiques contenus dans le fichier de patrons
DOC

#---------------------------------------------------
# debut du programme, ouverture en lecture du fichier passe en argument
#---------------------------------------------------
print "bonjour\n";
open(FIC, $ARGV[0]);

# ouverture d un fichier de trace, destine a recevoir les
# informations de traitements
# open(TRACE,">patron_sortietree.txt");
#---------------------------------------------------
# debut du programme, choix du nom du fichier en sortie
#---------------------------------------------------
#print "choisis un nom de fichier pour contenir les termes extraits\n";
my $fic=<STDIN>;
#---------------------------------------------------
# initialisation des variables
#---------------------------------------------------
open(FIC1, ">$fic");
my $i=0;
my $j=0;
my $k=0;
my @token=();
#---------------------------------------------------
# lecture du fichier de sortie TREETAGGER
# creation de 3 tableaux contenant les mots, les lemmes et les categories
#---------------------------------------------------
while (<FIC>)
 {
    my $ligne=$_;
	chomp $ligne;
    my @liste=split(/\t/,$ligne);
    push(@token, "$liste[$i++]" ." ");
    push(@patron, "$liste[$i++]" ." ");
    push(@lemme, "$liste[$i++]" ." ");
    $i=0;
}

#---------------------------------------------------
# on cree une liste vide destinee a recevoir les patrons
# presents dans le fichier lu a l etape precedente
# cette liste sera initialisee apres chaque construction
# de patron
#---------------------------------------------------
@sous_patron=();
#---------------------------------------------------
# creation de la liste des patrons lus dans le fichier
#  issu de treetagger
#---------------------------------------------------
while (defined($element_patron=shift(@patron))) {
    if ($element_patron !~ PUN && $element_patron !~ SENT) {
	push(@sous_patron, $element_patron);
	$j++;
	next;
    }
    my @sous_token=@token[$k..$j-1];
#   on va maintenant voir si le sous-patron construit est dans la
#   liste des patrons cherches (dans le fichier des patrons scrutes)
    &cherche_patron(@sous_patron);
    @sous_patron=();
    $k=$j+1;
#print "tape return pour continuer"
#my $reponse=<STDIN>;
 
    $j++;
}

#=============================================
# procedure de recherche des patrons
#=============================================

sub cherche_patron
 {
    my @liste=@_;
    my $suite_de_patrons=join("",@liste);
    $z=0;
    $nb=0;
#   ouverture du fichier des patrons cherches
    open(FIC, "$ARGV[1]");
    while(<FIC>) 
	{
	$nb=0;
	$ligne=$_;
	chomp $ligne;
	
	#print "voici le patron traité : $ligne\n";

	while ($ligne=~m/ /g) {$nb++};
	$nb++;
	while ($suite_de_patrons=~m/$ligne/g)
 {
	my $avant=substr ($suite_de_patrons, 0, pos($suite_de_patrons)-length($ligne));
	while ($avant=~m/ /g) {$z++}; 
	print FIC1 "@token[$k+$z..$k+$z+$nb-1]\n";
	$z=0;
	}
    }
    }
