#==========================================
# Module: Programmation et projets encadrés
#Auteur:   Zahir Maafa
#Date:     Avril 2006
#==========================================

#!/usr/bin/perl -w
use warnings;
use diagnostics;
use strict;
use locale;
<<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

exemples d utilisation avec les fichiers d exemple fournis :

perl trouve_terme_mod.pl SORTIE-TREETAGGER.txt patrons-1.txt> fichier des termes

DOC


my @liste;
my @termes;
my @patrons;
my $chpatrons;
my $sptrc;
my $i=0;
#===================================
# Lecture des termes et des patrons
#===================================

open(FIC,$ARGV[0]);
while (<FIC>)
{
@liste=split('\t',$_);
$termes[$i]=$liste[0];   # tableau des termes
$patrons[$i]=$liste[1]; # tableau des patrons
$i++;
}
$chpatrons=join(" ",@patrons);
 

$i=0;

close(FIC);
#===================================
# Lecture du fichier  des patrons
#===================================
open(FIC,$ARGV[1]);
open(FIC1,">res.txt");
while (defined($sptrc=<FIC>))
{
 $sptrc=~ s/\r//g;

 $sptrc=~ s/\n//g;

 cherche_patrons();

}

close(FIC);
close(FIC1);

#====================================
#La procedure de recherche
#====================================

sub cherche_patrons

{
my $base=0;
my $ch=$chpatrons;

my $t;
my $ii=0;
my @chu;
my $d=nb_terme($sptrc);

my $s=0;

# Localiser la suite des patrons
$chpatrons=~ s/$sptrc/1 $sptrc/g;
 



my @nptron=split(' ',$chpatrons);

while ($ii< $#nptron)
{
if ($nptron[$ii] eq "1")
{

 $ch= join(" ", @termes[$ii-$s..$ii-$s+$d-1]);
 if ($ch !~/[^a-zA-Z0-9çàáèéùîïæœëêôÿŸÈÉÊÇÎÏâÂÙŒÛûúÚ_\-\s]/)    # Minimiser les erreurs
 {
    print $ch ."\n";
 }
$s++;
}
$ii++;
}


}



#===================================
# compte le nombre de mots d'une chaîne
#===================================
sub nb_terme
{ my $chen=$_[0];

  my $nb=1;
  while ($chen=~ m/ /g)
{
$nb++;
}
  return $nb;
}