package termino;
use strict;
use warnings;
use diagnostics;
use utf8;
use Exporter;
our @EXPORT = qw(&listeCandidats);
our @ISA = qw(Exporter);
use utile;
use erreur;
my $localErreur={'pbEtik' =>"le texte n'est pas étiqueté dans un format valide",};
erreur::maj($localErreur);
my $fichLog="trace.txt";
open LOG,">:utf8","trace.txt" or erreur::affiche('ouvertureF',$fichLog);
my @listeSep=("PUN","SENT",);
sub listeCandidats{
my ($input,$fichPat,$output)=@_;
$output="listeCandidats.txt" unless defined $output;
my @lPat=chargePatron($fichPat);
open(IN,"<:utf8",$input);
open(OUT,">:utf8",$output);
my $flux=\*IN;
while(my $chunk=getChunk($flux)){
my @candidats=matchPatron($chunk,@lPat);
foreach my $tab (@candidats){ # chaque sorte de patron
foreach my $candidat (@$tab){ # chaque candidat
print OUT join(" ",@$candidat)."\n";
}
}
}
}
sub matchPatron{
my $chunk=shift;
my @lpat=@_;
my @terme=@{$chunk->{string}};
print LOG "chunk traité :\n".join(" ",@terme)."\n\n";
my @cat=@{$chunk->{type}};
print LOG "étiquetage correspondant : \n".join(" ",@cat)."\n\n";
my @lmatched;
for(my $i=0;$i<@cat;$i++){ # pour chaque position du chunk : début potentiel de syntagme matchant avec un patron
print LOG "commencerai par ".$cat[$i]."\n";
for(my $nPatron=0;$nPatron<@lpat;$nPatron++){ # pour chaque patron
my @patron=@{$lpat[$nPatron]};
print LOG "\tavec le patron ".join(" + ",@patron)."\n";
my $fin=@patron;
last if ($fin>@cat-$i); # on passe si le patron est trop long pour le morceau restant
my $j=0;
while(1){
if($j == $fin){ # le patron a matché entièrement
my @matched=@terme[$i..$i+$j-1];
print LOG "\t\t\t****trouve < ".join(" | ",@matched)." >****\n";
push (@{$lmatched[$nPatron]},\@matched);
# on range les résultats de chaque patron dans des tableaux différents au cas où l'on veut les distinguer par la suite
last;
}
print LOG "\t\t$patron[$j] ? $cat[$i+$j]";
if($patron[$j] ne $cat[$i+$j]){
print LOG "\n\t\t\t---echoue---\n";
last;
}; # le patron ne matche pas
print LOG " ok\n";
$j++;# pour l'instant le patron matche, on regarde la suite
}
}
}
return @lmatched;
}
sub chargePatron{
my $fich=shift;
open(PAT,"<:utf8",$fich) or erreur::affiche('ouvertureF',$fich);
my @lPat;
while(<PAT>){
my @patron=split(/[\s,;]+/,$_);
push @lPat,\@patron;
}
return @lPat;
}
sub getChunk{
my $flux=shift;
my (@type,@string,@lemme);
my %chunk= ('type'=>\@type,
'string'=>\@string,
'lemme'=>\@lemme);
while(1){
my $element=getElement($flux);
return undef unless defined($element);
last if estSepChunk($element->{type});
push @type,$element->{type};
push @string,$element->{string};
push @lemme,$element->{lemme};
}
return \%chunk;
}
sub getElement{
my $flux=shift;
my $texte="";
my $noeud;
while(1){
my $ligne=<$flux>;
return undef unless defined $ligne;
chomp($ligne);
$texte.=$ligne;
next unless $texte=~s/.*?<element>(.*?)<\/element>//;
$noeud=$1;
last;
}
my %elt;
foreach my $tag ("lemme","type","string"){
$noeud=~m/<data type="$tag">(.*?)<\/data>/ or erreur::affiche('pbEtik',$noeud);
$elt{$tag}=$1;
}
return \%elt;
}
sub estSepChunk{
my $type=shift;
return utile::appartient($type,@listeSep);
}
1;
