#!/usr/bin/perl


# Déclaration des pragmas
use strict;
use utf8;
use open qw/:std :utf8/;


# Appel des modules externes
use Encode qw(is_utf8);
use Getopt::Long;

# Recherche du nom du programme
my ($programme) = $0 =~ m|^(?:.*/)?(.+)|;
my $usage = "Usage : \n" . 
            "    $programme -t table -r répertoire [ -e extension ]* [ -s fichier_sortie ] [ -l log ] [ -cq ]\n" .
            "    $programme -t table -f fichier_entrée [ -s fichier_sortie ] [ -l log ] [ -cq ]\n" . 
            "    $programme -t table [ -l log ] [ -cq ]\n" . 
            "    $programme -h\n\n";

my $version     = "1.3.1";
my $dateModif   = "12 Mars 2019";

my @table = ();
my %genre = ();
my %liste = ();
my %pref  = ();
my %str   = ();

# Initialisation des variables globales
# nécessaires à la lecture des options
my $aide       = 0;
my $casse      = 0;
my $fichier    = "";
my $log        = "";
my $quiet      = 0;
my $repertoire = "";
my $sortie     = "";
my $table      = "";
my @extensions = ();

eval        {
        $SIG{__WARN__} = sub {usage(1);};
        GetOptions(
                "casse"        => \$casse,
                "extension=s"  => \@extensions,
                "fichier=s"    => \$fichier,
                "help"         => \$aide,
                "log=s"        => \$log,
                "quiet"        => \$quiet,
                "repertoire=s" => \$repertoire,
                "sortie=s"     => \$sortie,
                "table=s"      => \$table,
                );
        };
$SIG{__WARN__} = sub {warn $_[0];};

if ( $aide ) {
        print "\nProgramme : \n    \"$programme\", version $version ($dateModif)\n";
        print "    Adaptation du script Perl “IRC3.pl” permettant la reconnaissance et l’extraction \n";
        print "    dans un corpus de textes de noms scientifiques d’espèces animales ou végétales \n"; 
        print "    appartenant à une liste finie. En plus des noms in-extenso, ce programme recherche \n";
        print "    aussi les formes abrégées, par exemple : “C. lupus” pour “Canis lupus”. \n";
        print "    N.B. : la liste et les textes doivent être en UTF-8. \n\n";
        print $usage;
        print "Options :\n";
        print "    -c  tient compte de la casse (majuscule/minuscule) des termes recherchés \n";
        print "    -e  indique l'extension (e.g. “.txt”) du ou des fichiers textes à traiter \n";
        print "        (possibilité d’avoir plusieurs extensions en répétant l'option) \n";
        print "    -f  indique le nom du fichier texte à traiter \n";
        print "    -h  affiche cette aide \n";
        print "    -l  indique le nom du fichier récapitulatif où sera écrit pour chaque fichier \n";
        print "        traité le nombre de termes et d’occurrences trouvés\n";
        print "    -q  supprime l’affichage de la progression du travail \n";
        print "    -r  indique le répertoire contenant les fichiers textes à traiter \n";
        print "    -s  indique le nom du fichier où sera écrit le résultat du traitement \n";
        print "    -t  indique le nom du fichier contenant la ressource, c'est-à-dire la liste \n";
        print "        des termes à rechercher \n\n";
        print "Ressource : \n";
        print "    Le fichier de ressource contient un terme par ligne. On peut indiquer pour \n";
        print "    un terme sa forme préférentielle en ajoutant après le terme une ou plusieurs \n";
        print "    tabulations et le préférentiel. \n";
        print "    Les lignes vides et celles commençant par le caractère “#” ne sont pas prises \n";
        print "    en compte. De plus, la ressource peut être un fichier compressé par “gzip” ou \n";
        print "    “bzip2”. \n\n";
        print "Résultat : \n";
        print "    Le fichier résultat contient une ligne par occurrence trouvée. Chaque ligne \n";
        print "    est formée de 4 champs séparés par une tabulation. On a respectivement le nom \n";
        print "    du fichier traité (“STDIN” dans le cas de l'entrée standard), le terme tel \n";
        print "    qu'il est dans la ressource, le terme tel qu'il apparait dans le texte analysé \n";
        print "    et, dans le cas d'un synonyme, la forme préférentielle du terme. \n\n";
        exit 0;
        }

# Vérification de la présence des options obligatoires
usage(2) if not $table;

if ( $log ) {
        open(LOG, ">:utf8", "$log") or die "$!,";
        }
else    {
        open(LOG, "> /dev/null") or die "$!,";
        }

if ( ! -f $table ) {
        print STDERR "$programme : fichier \"$table\" absent\n";
        usage(5);
        }
elsif ( $table =~ /\.g?[zZ]\Z/ ) {
        open(TAB, "gzip -cd $table |") or die "$!, ";
        binmode TAB, ":utf8";
        }
elsif ( $table =~ /\.bz2\Z/ ) {
        open(TAB, "bzip2 -cd $table |") or die "$!, ";
        binmode TAB, ":utf8";
        }
else    {
        open(TAB, "<:utf8", $table) or die "$!, ";
        }

$SIG{'HUP'} = 'nettoye';
$SIG{'INT'} = 'nettoye';
$SIG{'TERM'} = 'nettoye';

print STDERR "\r", " " x 75, "\r Chargement de la ressource ...  " if not $quiet;

while (<TAB>) {
        next if /^#/o or /^\s*$/o;
        chomp;
        s/\r//go;

        # Vérification de jeu de caractères (doit être UTF-8)
        if ( not is_utf8($_, Encode::FB_QUIET) ) {
                print STDERR "Erreur : la table de référence doit être en UTF-8\n";
                exit 6;
                }

        my $pref =  "";
        my $terme = "";
        if ( /\t+/o ) {
                ($terme, $pref) = split(/\t+/o);
                }
        else    {
                $terme = $_;
                }
        $terme =~ s/^\p{IsSpace}+//o;
        $terme =~ s/\p{IsSpace}+\z//o;
#         $terme =~ s/\p{IsSpace}\p{IsSpace}+/ /o;
        my $str = $terme;
        if ( $terme =~ m|^\p{IsSpace}*\Z| or $terme =~ m|^\p{IsWord}-?\Z| ) {
                print STDERR "Terme refusé : \"$terme\"\n";
                next;
                }
        $terme = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, $terme)));
        $terme =~ s/  +/ /g;
        if ( not $casse ) {
                $terme = lc($terme);
                }
        if ( not $str{$terme} ) {
                $str{$terme} = $str;
                my ($genre) = $str =~ /^(.+?) /o;
                $genre{$genre} ++;
                if ( $casse ) {
                        $str{$genre} = $genre if not $str{$genre};
                        }
                else    {
                        my $tmp = lc($genre);
                        $str{$tmp} = $genre;
                        $genre = $tmp;
                        }
                push(@{$liste{$genre}}, $terme);
                }
        else    {
#                 print STDERR "Erreur : doublon \"$str{$terme}\" et \"$str\"\n";
                print LOG "doublon \"$str{$terme}\" et \"$str\"\n";
                next;
                }
        if ( $pref ) {
                $pref =~ s/^\p{IsSpace}+//o;
                $pref =~ s/\p{IsSpace}+\z//o;
#                 $pref =~ s/\p{IsSpace}\p{IsSpace}+/ /o;
                $str = $pref;
                if ( $pref =~ m|^\p{IsSpace}*\Z| or $terme =~ m|^\p{IsWord}-?\Z| ) {
                        print STDERR "Préférentiel refusé : \"$pref\"\n";
                        next;
                        }
                $pref = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, $terme)));
                $pref =~ s/  +/ /g;
                if ( not $casse ) {
                        $pref = lc($pref);
                        }
                if ( not $str{$pref} ) {
                        $str{$pref} = $str;
                        my ($genre) = $str =~ /^(.+?) /o;
                        $genre = lc($genre) if not $casse;
                        push(@{$liste{$genre}}, $pref);
                        }
                $pref{$terme} = $str;
                }
        }
close TAB;

my $prefRef   = \%pref;
my $strRef    = \%str;
my $fleche    = "";
my @resultats = ();

foreach my $genre (sort keys %liste) {
        if ( $casse ) {
                push(@table, sort @{$liste{$genre}}, $genre);
                }
        else    {
                push(@table, sort @{$liste{$genre}}, lc($genre));
                }
        }
my $nb = $#table + 1;

if ( $nb == 0 ) {
        print STDERR "\r", " " x 75, "\r Aucun terme présent dans la liste\n";
        exit 3;
        }

if ( not $quiet ) {
        my $tmp = $nb;
        1 while $tmp =~ s/(\d)(\d\d\d)\b/$1.$2/o;
        print STDERR "\r", " " x 75, "\r $tmp termes présents dans la liste\n" ;
        }

select(STDERR);
$| = 1;
select (STDOUT);

if ( $sortie ) {
        open(OUT, ">:utf8", $sortie) or die "$!,";
        select OUT;
        }

if ( $fichier ) {
        traite($fichier);
        }
elsif ( $repertoire ) {
        opendir(DIR, $repertoire) or die "$!,";
        my @fichiers = ();
        if ( @extensions ) {
                my $extensions = "(" . join("|", map {s/^\.//o; $_;} @extensions) . ")";
                @fichiers = grep(/\.$extensions\z/, grep(!/^\./o, readdir(DIR)));
                }
        else    {
                @fichiers = grep(!/^\./o, readdir(DIR));
                }
        closedir(DIR);
        foreach $fichier (sort @fichiers) {
                traite("$repertoire/$fichier");
                }
        }
else    {
        traite('-');
        }

nettoye();


exit 0;


sub usage
{
my $retour = shift;

print STDERR $usage;

exit $retour;
}

sub dich
{
my ($key, $tref, $nbi) = @_;
my ($binf) = -1;
my ($bsup) = $nbi;

while ( $bsup > $binf + 1 ) {
        my $bmid = int ( ( $bsup + $binf) / 2 );
        my $comp = $key cmp $tref->[$bmid];
        return $bmid if $comp == 0;
        if ( $comp > 0 ) {
                $binf = $bmid;
                }
        else    {
                $bsup = $bmid;
                }
        }
return (- $bsup - 1);
}

sub traite
{
my $input = shift;

my $nom   = "";
if ( $input eq '-' ) {
        open(INP, "<&STDIN") or die "Impossible de dupliquer STDIN: $!,";
        binmode(INP, ":utf8");
        $nom = "STDIN";
        }
else    {
        open(INP, "<:utf8", $input) or die "$!,";
        ($nom) = $input =~ m|^(?:.*/)?(.+)|o;
        }
        
my $texte     = "";
my @para      = ();
my %tmp       = ();

# On pense à vides la liste
@resultats = ();

# Première passe -> fléche simple
$fleche = '->';

print STDERR "\r", " " x 75, "\r Traite le fichier $nom  " if not $quiet;

while(<INP>) {
        # Vérification de jeu de caractères (doit être UTF-8)
        if ( not is_utf8($_, Encode::FB_QUIET) ) {
                if ( $nom eq 'STDIN' ) {
                        print STDERR "Erreur : le texte en entrée standard doit être en UTF-8\n";
                        }
                else    {
                        print STDERR "Erreur : le fichier \"$nom\" doit être en UTF-8\n";
                        }
                exit 7;
                }

        if ( /^\s*$/o ) {
                if ( $texte ) {
                        push(@para, $texte);
                        push(@resultats, recherche($nom, $texte));
                        $texte = "";
                        }
                next;
                }
        tr/\n\r/  /s;
        $texte .= $_;
        }

if ( $texte ) {
        push(@resultats, recherche($nom, $texte));
        $texte = "";
        }

close INP;

# Penser au cas où on ne trouve rien lors de la première passe
if ( not @resultats ) {
        print LOG "0\t0\t$nom\n";
        return;
        }

# Deuxième passe => fléche double
$fleche = '=>';

# Préparation de la table
my @tmp1 = sort grep {not $tmp{$_} ++;} @resultats;
my @tmp2 = ();
%tmp = ();
foreach my $terme (@tmp1) {
        my ($mot) = split(/\p{IsSpace}+/o, $terme);
        $mot = lc($mot) if not $casse;
        push(@tmp2, $mot);
        if ( $liste{$mot} ) {
                push(@tmp2, @{$liste{$mot}});
                }
        else    {
                push(@tmp2, grep(/^$mot\p{IsSpace}/, @table));
                }
        }
@tmp1 = sort grep {not $tmp{$_} ++;} @tmp2;

my %tmpPref = ();
my %tmpStr  = ();

@tmp2 = ();
foreach my $terme (@tmp1) {
        if ( $casse ) {
                my $str = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, $terme)));
                push(@tmp2, $terme);
                $tmpStr{$str} = $terme;
                if ( $terme =~ /^(\p{IsUpper})\P{IsSpace}+\p{IsSpace}+(.+)/o ) {
                        my $abrev = "$1. $2";
                        $str = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, $abrev)));
                        push(@tmp2, $str);
                        $tmpStr{$str} = $abrev;
                        if ( $tmpPref{$str} ) {
                                $tmpPref{$str} .= " ; $terme";
                                }
                        else    {
                                $tmpPref{$str} = $terme;
                                }
                        }
                }
        else    {
                my $str = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, lc($terme))));
                push(@tmp2, $str);
                if ( $str{$terme} ) {
                        $tmpStr{$terme} = $str{$terme};
                        $tmpStr{$str} = $str{$terme} if $str ne $terme;
                        }
                if ( $terme =~ /^(\p{IsLower})\P{IsSpace}+\p{IsSpace}+(.+)/o ) {
                        my $abrev = "$1. $2";
                        $str = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, lc($abrev))));
                        push(@tmp2, $str);
                        $tmpStr{$str} = "\u$abrev";
                        if ( $tmpPref{$str} ) {
                                $tmpPref{$str} .= " ; " . $terme;
                                }
                        else    {
                                $tmpPref{$str} = $terme;
                                }
                        }
                }
        }
%tmp = ();
@tmp1 = sort grep{not $tmp{$_} ++;} @tmp2;

@resultats = ();
%tmp = ();

# On point sur les nouveaux hachages ...
$prefRef = \%tmpPref;
$strRef  = \%tmpStr;

foreach my $para (@para) {
        push(@resultats, recherche($nom, $para, \@tmp1));
        }

# Traitement des ambigüités toujours présentes
@tmp1 = grep{not $tmp{$_} ++;} grep(/\t\?.+\?\z/, @resultats);
if ( @tmp1 ) {
        @tmp2 = grep(!/\t\?.+\?\z/, @resultats);
        foreach my $item (@tmp1) {
                my ($t1, $t2, $t3) = split(/\t/, $item);
                %tmp = ();
                my @tmp3 = grep{not $tmp{$_} ++;} grep(/./, split(/\?/, $t3));
                my %score = ();
                foreach my $pref (@tmp3) {
                        $score{$pref} = grep(/$t1\t[^\t]+\t$pref\z/, @tmp2);
                        }
                my @tmp = sort {$score{$b} <=> $score{$a}} grep {$score{$_} > 0;} keys %score;
                if ( $#tmp == 0 ) {
                        foreach my $resultat (@resultats) {
                                if ( $resultat eq $item ) {
                                        $resultat = "$t1\t$t2\t$tmp[0]";
                                        }
                                }
                        }
                next if @tmp;
                %score = ();
                foreach my $pref (@tmp3) {
                        $score{$pref} = grep(/\t$pref\z/, @tmp2);
                        }
                @tmp = sort {$score{$b} <=> $score{$a}} grep {$score{$_} > 0;} keys %score;
                if ( $#tmp == 0 ) {
                        foreach my $resultat (@resultats) {
                                if ( $resultat eq $item ) {
                                        $resultat = "$t1\t$t2\t$tmp[0]";
                                        }
                                }
                        next;
                        }
                %tmp = ();
                foreach my $pref (@tmp3) {
                        my ($genre) = $pref =~ /^(.+?) /o;
                        $tmp{$genre} ++;
                        }
                for ( my $n = 1 ; $n <= $#resultats ; $n ++ ) {
                        if ( $resultats[$n] eq $item ) {
                                for ( my $m = $n ; $m >= 0 ; $m -- ) {
                                        my ($terme) = $resultats[$m] =~ /^(.+?)\s/o;
                                        next if not $genre{$terme};
                                        if ( $tmp{$terme} ) {
                                                @tmp = grep(/^$terme /, @tmp3);
                                                if ( $#tmp == 0 ) {
                                                        foreach my $resultat (@resultats) {
                                                                if ( $resultat eq $item ) {
                                                                        $resultat = "$t1\t$t2\t$tmp[0]";
                                                                        }
                                                                }
                                                        }
                                                }
                                        }
                                }
                        }
                }
        }


# ... et retour aux hachages par défaut.
$prefRef = \%pref;
$strRef  = \%str;

while( my $resultat = shift @resultats ) {
        my @champs = split(/\t/, $resultat);
        next if $genre{$champs[0]};
        print STDERR "\r", " " x 75, "\r";
        print "$nom\t$resultat\n";
        if ( $champs[2] ) {
                if ( $champs[2] =~ /^\?.+\?\z/o ) {
                        print STDERR "ATTENTION ! $nom : ambiguïté sur la forme non abrégée de “$champs[0]” !\n";
                        print LOG "ATTENTION ! $nom : ambiguïté sur la forme non abrégée de “$champs[0]” !\n";
                        }
                else    {
                        $tmp{$champs[2]} ++;
                        }
                }
        else    {
                $tmp{$champs[0]} ++;
                }
        }

my $nb_refs = 0;
my $nb_occs = 0;

foreach my $ref (keys %tmp) {
        $nb_refs ++;
        $nb_occs += $tmp{$ref};
        }

printf LOG "%d\t%d\t%s\n", $nb_refs, $nb_occs, $nom;
}

sub recherche
{
my $cle  = undef;
my $orig = undef;
my $tref = undef;
my $nbi  = $nb;

($cle, $orig, $tref) = @_;

if ( not defined $tref ) {
        $tref = \@table;
        }
else    {
        $nbi = $#{$tref} + 1;
        }

$orig =~ s/^\p{IsSpace}+//o;
$orig =~ s/\p{IsSpace}+\z//o;

my $rec = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, $orig)));

if ( ! $casse ) {
        $rec = lc($rec);
        }

my $terme = "";
my @matchs = ();

while ( length($rec) ) {
        my $retour = dich($rec, $tref, $nbi);
        if ( $retour > -1 ) {
                print STDERR "\r", " " x 75, "\r" if not $quiet;
                $terme = $tref->[$retour];
                my $tmp = $tref->[$retour];
                $terme =~ s/(\P{IsWord})/\\$1/g;
                $terme =~ s/\\ / */og;
                $terme =~ s/([^\x20-\x7F])/./og;
                if ( $orig =~ /^$terme\b/ or ( ! $casse and $orig =~ /^$terme\b/i ) ) {
                        my $chaine = $&;
                        if ( $chaine =~ /\p{IsUpper}/o ) {
                                push(@matchs, "$strRef->{$tmp}\t$chaine");
                                if ( defined $prefRef->{$tmp} ) {
                                        if ( $prefRef->{$tmp} =~ / ; /o ) {
                                                my @possibles = split(/ ; /, $prefRef->{$tmp});
                                                my $probable = desambiguise(\@possibles, \@matchs);
                                                if ( $probable ) {
                                                        $matchs[$#matchs] .= "\t$strRef->{$probable}";
                                                        }
                                                else    {
                                                        $probable = join('?', map {$strRef->{$_}} @possibles);
                                                        $matchs[$#matchs] .= "\t?$probable?";
                                                        }
                                                }
                                        else    {
                                                $matchs[$#matchs] .= "\t$strRef->{$prefRef->{$tmp}}";
                                                }
                                        }
                                }
                        }
                else    {
                        push(@matchs, "$strRef->{$tmp}\t*** ERREUR ***");
                        print STDERR "ERREUR (1) sur la recherche de l'original $cle\n";
                        }
                if ( not $quiet and not $genre{$strRef->{$tmp}} ) {
#                if ( not $quiet ) {
                        print STDERR "$cle $fleche $strRef->{$tmp}\n";
                        print STDERR " Traite le fichier $cle  ";
                        }
                }
        else    {
                $retour = - 2 - $retour;
                $terme = $tref->[$retour];
                my ($debut) = $terme =~ m|^(.*?\p{IsWord}+)|;
                $debut =~ s/(\P{IsWord})/\\$1/g;
                do {
                        $terme =~ s/(\P{IsWord})/\\$1/g;
                        if ( $rec =~ /^$terme\b/ ) { # Mot exact seulement
                                print STDERR "\r", " " x 75, "\r" if not $quiet;
                                $terme =~ s/\\ /\\p{IsSpace}*/og;
                                $terme =~ s/([^\x20-\x7F])/./og;
                                my $tmp = $tref->[$retour];
                                if ( $orig =~ /^$terme/ or ( ! $casse and $orig =~ /^$terme/i ) ) {
                                        my $chaine = $&;
                                        if ( $chaine =~ /\p{IsUpper}/o ) {
                                                push(@matchs, "$strRef->{$tmp}\t$chaine");
                                                if ( defined $prefRef->{$tmp} ) {
                                                        if ( $prefRef->{$tmp} =~ / ; /o ) {
                                                                my @possibles = split(/ ; /, $prefRef->{$tmp});
                                                                my $probable = desambiguise(\@possibles, \@matchs);
                                                                if ( $probable ) {
                                                                        $matchs[$#matchs] .= "\t$strRef->{$probable}";
                                                                        }
                                                                else    {
                                                                        $probable = join('?', map {$strRef->{$_}} @possibles);
                                                                        $matchs[$#matchs] .= "\t?$probable?";
                                                                        }
                                                                }
                                                        else    {
                                                                $matchs[$#matchs] .= "\t$strRef->{$prefRef->{$tmp}}";
                                                                }
                                                        }
                                                }
                                        }
                                else    {
                                        push(@matchs, "$strRef->{$tmp}\t*** ERREUR ***");
                                        print STDERR "ERREUR (2) sur la recherche de l'original $cle\n";
                                        }
                                if ( not $quiet and not $genre{$strRef->{$tmp}} ) {
#                                if ( not $quiet ) {
                                        print STDERR "$cle $fleche $strRef->{$tmp}\n";
                                        print STDERR " Traite le fichier $cle  ";
                                        }
                                $retour = 0;
                                }
                        if ( $retour > 0 ) {
                                $terme = $tref->[--$retour];
                                }
                        else    {
                                $terme = "";
                                }
                        } until $terme !~ /^$debut/;
                }
        $rec =~ s/^\P{IsSpace}+\p{IsSpace}?//;
        if ( $orig =~ /^\p{IsWord}+\p{IsSpace}*/ ) {
                $orig =~ s/^\p{IsWord}+\p{IsSpace}*//;
                }
        elsif ( $orig =~ /^\p{IsSpace}+\P{IsWord}\p{IsSpace}*/ ) {
                $orig =~ s/^\p{IsSpace}+\P{IsWord}\p{IsSpace}*//;
                }
        elsif ( $orig =~ /^\P{IsWord}\p{IsSpace}*/ ) {
                $orig =~ s/^\P{IsWord}\p{IsSpace}*//;
                }
        else    {
                print STDERR "ERREUR sur le texte intégral : $orig\n";
                }
        }

return @matchs;
}

sub desambiguise
{
my $ptrPossibles = shift;
my $ptrMatchs    = shift;
return undef;
my @references = ();

foreach my $resultat (@resultats) {
        my @tmp = split(/\t/, $resultat);
        if ( $tmp[2] ) {
                next if $tmp[2] =~ /^\?.+\?\z/o;
                push(@references, $tmp[2]);
                }
        elsif ( $tmp[0] !~ /^\w\. /o ) {
                push(@references, $tmp[0]);
                }
        }

foreach my $resultat (@{$ptrMatchs}) {
        my @tmp = split(/\t/, $resultat);
        if ( $tmp[2] ) {
                next if $tmp[2] =~ /^\?.+\?\z/o;
                push(@references, $tmp[2]);
                }
        elsif ( $tmp[0] !~ /^\w\. /o ) {
                push(@references, $tmp[0]);
                }
        }

my %score = ();
my %tmp   = ();

my @liste = grep {not $tmp{$_} ++;} reverse @references;

foreach my $possible (@{$ptrPossibles}) {
        foreach my $item (@liste) {
                if ( $item eq $str{$possible} ) {
                        $score{$possible} = 1 ;
                        }
                }
        }

my @tmp = sort keys %score;
if ( $#tmp == 0 ) {
        return $tmp[0];
        }

foreach my $item (@liste) {
        my ($genre) = $item =~ /^(\S+) /o;
        next if not $genre;
        if ( not $casse ) {
                $genre = lc($genre);
                }
        my ($possible) = grep(/^$genre /, @{$ptrPossibles});
        return $possible if $possible;
        }
}

sub nettoye
{
if ( not $quiet ) {
        print STDERR "\r", " " x 75, "\r";
        print STDERR "\n";
        }

exit 0;
}