diff --git a/IRC3sp/IRC3sp.pl b/IRC3sp/IRC3sp.pl index 98c744e..8ba41cd 100755 --- a/IRC3sp/IRC3sp.pl +++ b/IRC3sp/IRC3sp.pl @@ -9,17 +9,23 @@ # Appel des modules externes use Encode qw(is_utf8); +# use Getopt::Long qw(:config bundling); +# use Getopt::Long qw(:config no_ignore_case bundling); use Getopt::Long; +use POSIX qw(mkfifo); +use JSON; # Recherche du nom du programme my ($programme) = $0 =~ m|^(?:.*/)?(.+)|; -my $usage = "Usage : \n" . +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 -f (fichier_entrée|-) [ -s fichier_sortie ] [ -l log ] [ -cq ]\n" . + " $programme -t table -j [ -f fichier_entrée ] [ -s fichier_sortie ] [ -l log ] [ -cq ]\n" . + " $programme -t table -p FIFO [ -l log ] [ -cw ]\n" . " $programme -h\n\n"; -my $version = "1.3.2"; -my $dateModif = "12 Mars 2019"; +my $version = "4.5.1"; +my $dateModif = "31 Août 2022"; my @table = (); my %genre = (); @@ -29,15 +35,21 @@ # 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 $aide = undef; +my $casse = undef; +my $fichier = undef; +my $json = undef; +my $log = undef; +my $fifo = undef; +my $quiet = undef; +my $repertoire = undef; +my $sortie = undef; +my $table = undef; +my $ws = undef; my @extensions = (); +my $recherche = 0; +# Getopt::Long::Configure("no_ignore_case"); +# Getopt::Long::Configure("bundling"); eval { $SIG{__WARN__} = sub {usage(1);}; @@ -45,12 +57,15 @@ "casse" => \$casse, "extension=s" => \@extensions, "fichier=s" => \$fichier, + "json" => \$json, "help" => \$aide, "log=s" => \$log, + "pipe=s" => \$fifo, "quiet" => \$quiet, "repertoire=s" => \$repertoire, "sortie=s" => \$sortie, "table=s" => \$table, + "webservice" => \$ws, ); }; $SIG{__WARN__} = sub {warn $_[0];}; @@ -58,7 +73,7 @@ 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 " 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"; @@ -67,15 +82,22 @@ 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 " -f indique le nom du fichier texte à traiter (pour lire les données sur \n"; + print " l’entrée standard, utilisez un tiret “-” comme argument) \n"; print " -h affiche cette aide \n"; + print " -j indique que les données en entrée, dans un fichier ou sur l’entrée standard, \n"; + print " sont en JSON ainsi que le résultat en sortie \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 " -p indique le nom du tube nommé (“named pipe”) ou FIFO utilisé pour transmettre \n"; + print " les données \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 " des termes à rechercher \n"; + print " -w indique que le programme est utilisé par un “webservice” qui modifie le fichier \n"; + print " envoyé en ne gardant que les objets JSON \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"; @@ -85,17 +107,18 @@ 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 " est formée de 5 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"; + print " qu'il apparait dans le texte analysé, la forme abrégée du terme tel qu'il est \n"; + print " dans la ressource si c’est une forme abrégée qui a été trouvée, le terme tel \n"; + print " qu'il est dans la ressource et, dans le cas d'un synonyme, la forme préférentielle \n"; + print " du terme. \n\n"; exit 0; } # Vérification de la présence des options obligatoires usage(2) if not $table; -usage(2) if not $fichier and not $repertoire; -usage(2) if $fichier and $repertoire; +usage(2) if not $fichier and not $repertoire and not $json and not $fifo; if ( $log ) { open(LOG, ">:utf8", "$log") or die "$!,"; @@ -120,9 +143,14 @@ open(TAB, "<:utf8", $table) or die "$!, "; } -$SIG{'HUP'} = 'nettoye'; -$SIG{'INT'} = 'nettoye'; -$SIG{'TERM'} = 'nettoye'; +$SIG{'HUP'} = 'nettoie'; +$SIG{'INT'} = 'nettoie'; +$SIG{'TERM'} = 'nettoie'; + +if ( $fifo ) { + $quiet = 2; + mkfifo($fifo, 0666) or die "Impossible de créer FIFO\x{A0}: $!,"; + } print STDERR "\r", " " x 75, "\r Chargement de la ressource ... " if not $quiet; @@ -160,17 +188,17 @@ } if ( not $str{$terme} ) { $str{$terme} = $str; - my ($genre) = $str =~ /^(.+?) /o; + my ($genre) = $str =~ /^(\P{IsWord}*\p{IsWord}.*?) .+/o ? $1 : $str; $genre{$genre} ++; + my $tmp = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, $genre))); if ( $casse ) { - $str{$genre} = $genre if not $str{$genre}; + $str{$tmp} = $genre if not $str{$tmp}; } else { - my $tmp = lc($genre); + $tmp = lc($tmp); $str{$tmp} = $genre; - $genre = $tmp; } - push(@{$liste{$genre}}, $terme); + push(@{$liste{$tmp}}, $terme); } else { # print STDERR "Erreur : doublon \"$str{$terme}\" et \"$str\"\n"; @@ -182,20 +210,28 @@ $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| ) { + if ( $pref =~ m|^\p{IsSpace}*\Z| or $pref =~ m|^\p{IsWord}-?\Z| ) { print STDERR "Préférentiel refusé : \"$pref\"\n"; next; } - $pref = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, $terme))); + $pref = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, $pref))); $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); + my ($genre) = $str =~ /^(\P{IsWord}*\p{IsWord}.*?) .+/o ? $1 : $str; + $genre{$genre} ++; + my $tmp = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, $genre))); + if ( $casse ) { + $str{$tmp} = $genre if not $str{$tmp}; + } + else { + $tmp = lc($tmp); + $str{$tmp} = $genre; + } + push(@{$liste{$tmp}}, $pref); } $pref{$terme} = $str; } @@ -228,6 +264,57 @@ print STDERR "\r", " " x 75, "\r $tmp termes présents dans la liste\n" ; } +if ( $fifo ) { + # $quiet = 0; + $json = undef; + $sortie = undef; + my $retour = undef; + my @json = (); + + while( 1 ) { + open(INP, "<:raw", $fifo) or die "$!,"; + # binmode(INP, ":raw"); + while() { + if ( /^%% JOB POUR FIFO (.+)$/o ) { + $sortie = $1; + open(OUT, ">:utf8", $sortie) or die "$!,"; + } + elsif ( /^%% FIN JOB/o ) { + $sortie = undef; + if ( $ws ) { + $json = '[' . join(",", @json) . ']'; + @json = passe1($json); + foreach $json (@json) { + print OUT "$json\n"; + } + @json = (); + } + else { + ($json, $retour) = passe1($json); + print OUT $json; + } + close OUT; + $json = undef; + } + elsif ( $sortie ) { + if ( $ws ) { + push(@json, $_); + } + else { + $json .= $_; + } + } + elsif ( /^%% STOP IRC3/o ) { + unlink $fifo; + exit 0; + } + } + close INP; + } + nettoie(); + exit 2; + } + select(STDERR); $| = 1; select (STDOUT); @@ -237,7 +324,15 @@ select OUT; } -if ( $fichier ) { +if ( $json ) { + if ( $fichier ) { + traite_json($fichier); + } + else { + traite_json('-'); + } + } +elsif ( $fichier ) { traite($fichier); } elsif ( $repertoire ) { @@ -256,7 +351,7 @@ } } -nettoye(); +nettoie(); exit 0; @@ -264,11 +359,9 @@ sub usage { -my $retour = shift; +print STDERR "\n$usage"; -print STDERR $usage; - -exit $retour; +exit shift; } sub dich @@ -305,7 +398,7 @@ open(INP, "<:utf8", $input) or die "$!,"; ($nom) = $input =~ m|^(?:.*/)?(.+)|o; } - + my $texte = ""; my @para = (); my %tmp = (); @@ -355,22 +448,210 @@ return; } +@resultats = passe2($nom, \@resultats, \@para); +} + +sub traite_json +{ +my $nom = shift; + +if ( $nom eq '-' ) { + open(INP, "<&STDIN") or die "Impossible de dupliquer STDIN: $!,"; + binmode(INP, ":raw"); + $nom = 'STDIN'; + } +else { + open(INP, "<:raw", $nom) or die "$!,"; + } + +my $texte = undef; +my @id = (); +my @para = (); +my %para = (); +my %resultats = (); +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; + +my $input = ""; +my @input = (); +my %input = (); + +while() { + $input .= $_; + } +close INP; + +my ($json, $retour) = passe1($input); + +print $json; + +if ( $retour ) { + nettoie(); + exit $retour; + } +} + +sub passe1 +{ +my $input = shift; + +# Variables +my $nom = undef; +my $texte = undef; +my @id = (); +my @input = (); +my @para = (); +my %input = (); +my %para = (); +my %resultats = (); +my %tmp = (); + +my $perl = undef; +eval { + $perl = decode_json $input; + }; +if ( $@ ) { + $@ =~ s/"/\\"/go; + $@ =~ s/[\r\n]//go; + $@ =~ s/at $0 .+//go; + if ( $ws ) { + return("{\"message\": \"erreur de conversion des données JSON vers Perl.\", \"explication\": \"$@\"}\n"); + } + else { + return("[{\"message\": \"erreur de conversion des données JSON vers Perl.\", \"explication\": \"$@\"}]\n", 4); + } + } +if ( ref($perl) eq 'ARRAY' ) { + @input = @{$perl}; + foreach my $doc (@input) { + my %doc = %{$doc}; + $nom = $doc{'id'}; + push(@id, $nom); + my $value = $doc{'value'}; + if ( ref($value) eq 'ARRAY' ) { + my @values = @{$value}; + foreach my $item (@values) { + push(@para, $item); + push(@resultats, recherche($nom, $item)); + } + } + else { + push(@para, $value); + push(@resultats, recherche($nom, $value)); + } + if ( @resultats ) { + @{$para{$nom}} = @para; + @para = (); + @{$resultats{$nom}} = @resultats; + @resultats = (); + } + + } + } +elsif ( ref($perl) eq 'HASH' ) { + %input = %{$perl}; + $nom = $input{'id'}; + push(@id, $nom); + my $value = $input{'value'}; + if ( ref($value) eq 'ARRAY' ) { + my @values = @{$value}; + foreach my $item (@values) { + push(@para, $item); + push(@resultats, recherche($nom, $item)); + } + } + else { + push(@para, $value); + push(@resultats, recherche($nom, $value)); + } + if ( @resultats ) { + @{$para{$nom}} = @para; + @para = (); + @{$resultats{$nom}} = @resultats; + @resultats = (); + } + } + +my @tmp = (); +foreach $nom (@id) { + my @ambigus = (); + my %especes = (); + my $tmp = " {\n \"id\": \"$nom\",\n"; + if ( defined $resultats{$nom} ) { + @resultats = passe2($nom, \@{$resultats{$nom}}, \@{$para{$nom}}); +# foreach my $item (@resultats) { + while ( my $item = shift @resultats ) { + my @champs = split(/\t/, $item); + if ( $champs[2] =~ /^\?.+\?\z/o ) { + push(@ambigus, $item); + } + else { + $especes{$champs[2]} ++; + } + } + } + my @especes = sort keys %especes; + if ( @especes ) { + $tmp .= $ws ? " \"value\": [\n" : " \"species\": [\n"; + while (my $item = shift @especes) { + $tmp .= " \"$item\""; + $tmp .= ", " if @especes; + $tmp .= "\n"; + } + $tmp .= " ]\n"; + } + else { + $tmp .= " \"species\": []\n"; + } + $tmp .= " }"; + push(@tmp, $tmp); + } +if ( $ws ) { + foreach my $item (@tmp) { + $item =~ s/^ *//o; + $item =~ s/,\n */, /go; + $item =~ s/\n *//go; + } + return @tmp; + } +else { + return ("[\n" . join(",\n", @tmp) . "\n]\n", 0); + } +} + +sub passe2 +{ +my ($id, $ref_liste, $ref_para) = @_; +my @liste = @{$ref_liste}; +my @para = @{$ref_para}; + # Deuxième passe => fléche double $fleche = '=>'; # Préparation de la table -my @tmp1 = sort grep {not $tmp{$_} ++;} @resultats; +my %tmp = (); +my @tmp1 = sort grep {not $tmp{$_} ++;} @liste; 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}}); + +foreach my $item (@tmp1) { + my ($terme) = split(/\t/o, $item); + my ($genre) = $terme =~ /^(\P{IsWord}*\p{IsWord}.*?) .+/o ? $1 : $terme; + $genre = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, $genre))); + $genre = lc($genre) if not $casse; + push(@tmp2, $genre); + if ( $liste{$genre} ) { + push(@tmp2, @{$liste{$genre}}); } else { - push(@tmp2, grep(/^$mot\p{IsSpace}/, @table)); + push(@tmp2, grep(/^$genre\p{IsSpace}/, @table)); } } @tmp1 = sort grep {not $tmp{$_} ++;} @tmp2; @@ -381,38 +662,50 @@ @tmp2 = (); foreach my $terme (@tmp1) { if ( $casse ) { - my $str = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, $terme))); + # my $str = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, $terme))); push(@tmp2, $terme); - $tmpStr{$str} = $terme; + if ( $str{$terme} ) { + $tmpStr{$terme} = $str{$terme}; + } + else { + print STDERR "Pas de forme canonique pour \"$terme\"\n"; + next; + } if ( $terme =~ /^(\p{IsUpper})\P{IsSpace}+\p{IsSpace}+(.+)/o ) { my $abrev = "$1. $2"; - $str = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, $abrev))); + my $str = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, $abrev))); push(@tmp2, $str); $tmpStr{$str} = $abrev; if ( $tmpPref{$str} ) { - $tmpPref{$str} .= " ; $terme"; + $tmpPref{$str} .= " ; $str{$terme}"; } else { - $tmpPref{$str} = $terme; + $tmpPref{$str} = $str{$terme}; } } } else { - my $str = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, lc($terme)))); - push(@tmp2, $str); + # my $str = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, lc($terme)))); + push(@tmp2, $terme); if ( $str{$terme} ) { $tmpStr{$terme} = $str{$terme}; - $tmpStr{$str} = $str{$terme} if $str ne $terme; + # $tmpStr{$str} = $str{$terme} if $str ne $terme; + } + else { + print STDERR "Pas de forme canonique pour \"$terme\"\n"; + next; } if ( $terme =~ /^(\p{IsLower})\P{IsSpace}+\p{IsSpace}+(.+)/o ) { my $abrev = "$1. $2"; - $str = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, lc($abrev)))); + my $str = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, lc($abrev)))); push(@tmp2, $str); $tmpStr{$str} = "\u$abrev"; if ( $tmpPref{$str} ) { + # $tmpPref{$str} .= " ; " . $str{$terme}; $tmpPref{$str} .= " ; " . $terme; } else { + # $tmpPref{$str} = $str{$terme}; $tmpPref{$str} = $terme; } } @@ -421,7 +714,7 @@ %tmp = (); @tmp1 = sort grep{not $tmp{$_} ++;} @tmp2; -@resultats = (); +@liste = (); %tmp = (); # On point sur les nouveaux hachages ... @@ -429,13 +722,13 @@ $strRef = \%tmpStr; foreach my $para (@para) { - push(@resultats, recherche($nom, $para, \@tmp1)); + push(@liste, recherche($id, $para, \@tmp1)); } # Traitement des ambigüités toujours présentes -@tmp1 = grep{not $tmp{$_} ++;} grep(/\t\?.+\?\z/, @resultats); +@tmp1 = grep{not $tmp{$_} ++;} grep(/\t\?.+\?\z/, @liste); if ( @tmp1 ) { - @tmp2 = grep(!/\t\?.+\?\z/, @resultats); + @tmp2 = grep(!/\t\?.+\?\z/, @liste); foreach my $item (@tmp1) { my ($t1, $t2, $t3) = split(/\t/, $item); %tmp = (); @@ -446,7 +739,7 @@ } my @tmp = sort {$score{$b} <=> $score{$a}} grep {$score{$_} > 0;} keys %score; if ( $#tmp == 0 ) { - foreach my $resultat (@resultats) { + foreach my $resultat (@liste) { if ( $resultat eq $item ) { $resultat = "$t1\t$t2\t$tmp[0]"; } @@ -459,7 +752,7 @@ } @tmp = sort {$score{$b} <=> $score{$a}} grep {$score{$_} > 0;} keys %score; if ( $#tmp == 0 ) { - foreach my $resultat (@resultats) { + foreach my $resultat (@liste) { if ( $resultat eq $item ) { $resultat = "$t1\t$t2\t$tmp[0]"; } @@ -471,15 +764,15 @@ my ($genre) = $pref =~ /^(.+?) /o; $tmp{$genre} ++; } - for ( my $n = 1 ; $n <= $#resultats ; $n ++ ) { - if ( $resultats[$n] eq $item ) { + for ( my $n = 1 ; $n <= $#liste ; $n ++ ) { + if ( $liste[$n] eq $item ) { for ( my $m = $n ; $m >= 0 ; $m -- ) { - my ($terme) = $resultats[$m] =~ /^(.+?)\s/o; + my ($terme) = $liste[$m] =~ /^(.+?)\s/o; next if not $genre{$terme}; if ( $tmp{$terme} ) { @tmp = grep(/^$terme /, @tmp3); if ( $#tmp == 0 ) { - foreach my $resultat (@resultats) { + foreach my $resultat (@liste) { if ( $resultat eq $item ) { $resultat = "$t1\t$t2\t$tmp[0]"; } @@ -497,15 +790,28 @@ $prefRef = \%pref; $strRef = \%str; -while( my $resultat = shift @resultats ) { +@tmp1 = (); + +while( my $resultat = shift @liste ) { 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"; + $resultat = "$champs[1]\t$champs[0]\t$champs[2]\t$pref{$champs[2]}"; + } + else { + $resultat = "$champs[1]\t\t$champs[0]\t$pref{$champs[0]}"; + } + print STDERR "\r", " " x 75, "\r" if not $quiet; + if ( $json ) { + push(@tmp1, $resultat); + } + else { + print "$id\t$resultat\n"; + } + if ( $champs[2] ) { + if ( $champs[2] =~ /^\?.+\?\z/o and not $json ) { + print STDERR "ATTENTION ! $id : ambiguïté sur la forme non abrégée de “$champs[0]” !\n" if not $quiet; + print LOG "ATTENTION ! $id : ambiguïté sur la forme non abrégée de “$champs[0]” !\n"; } else { $tmp{$champs[2]} ++; @@ -524,7 +830,9 @@ $nb_occs += $tmp{$ref}; } -printf LOG "%d\t%d\t%s\n", $nb_refs, $nb_occs, $nom; +printf LOG "%d\t%d\t%s\n", $nb_refs, $nb_occs, $id; + +return @tmp1 if $json; } sub recherche @@ -542,12 +850,9 @@ 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); } @@ -557,12 +862,14 @@ while ( length($rec) ) { my $retour = dich($rec, $tref, $nbi); + my $bout = join(" ", (grep(/\P{IsSpace}/, split(/( )/, $rec)))[0 .. 1] ); + my $biniou = 1; 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/(\P{IsWord})/\\$1/go; + $terme =~ s/\\ /\\s*/og; $terme =~ s/([^\x20-\x7F])/./og; if ( $orig =~ /^$terme\b/ or ( ! $casse and $orig =~ /^$terme\b/i ) ) { my $chaine = $&; @@ -601,53 +908,78 @@ $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}"; + if ( $debut and $rec =~ /^$debut\b/ ) { + do { + # print "$retour\t$debut\t$terme\t$bout\n"; + $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; + my $alt = $terme; + $alt =~ s/(\\?[^\x20-\x7F])/./og; + my $tmp = $tref->[$retour]; + if ( $orig =~ /^$terme/ or ( not $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 { - $probable = join('?', map {$strRef->{$_}} @possibles); - $matchs[$#matchs] .= "\t?$probable?"; + $matchs[$#matchs] .= "\t$strRef->{$prefRef->{$tmp}}"; } } - else { - $matchs[$#matchs] .= "\t$strRef->{$prefRef->{$tmp}}"; - } } } + elsif ( $orig =~ /^$alt/ or ( not $casse and $orig =~ /^$alt/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}} ) { + print STDERR "$cle $fleche $strRef->{$tmp}\n"; + print STDERR " Traite le fichier $cle "; + } + $retour = 0; + } + if ( $retour > 0 ) { + $terme = $tref->[--$retour]; } else { - push(@matchs, "$strRef->{$tmp}\t*** ERREUR ***"); - print STDERR "ERREUR (2) sur la recherche de l'original $cle\n"; + $terme = ""; } - 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/; + } until $terme !~ /^$debut/; + } } $rec =~ s/^\P{IsSpace}+\p{IsSpace}?//; if ( $orig =~ /^\p{IsWord}+\p{IsSpace}*/ ) { @@ -725,8 +1057,11 @@ } } -sub nettoye +sub nettoie { +if ( $fifo and -p $fifo ) { + unlink $fifo; + } if ( not $quiet ) { print STDERR "\r", " " x 75, "\r"; print STDERR "\n"; diff --git a/IRC3sp/README.md b/IRC3sp/README.md index c975114..2364040 100644 --- a/IRC3sp/README.md +++ b/IRC3sp/README.md @@ -1,64 +1,79 @@ IRC3sp =============== -**IRC3sp** est une version de l’outil **IRC3** dédiée à la recherche des noms scientifiques — ou noms binominaux — d’espèces animales, végétales ou autres dans un corpus de textes en se référant à une liste finie (mais, aussi exhaustive que possible). +**IRC3sp** est une version de l’outil **IRC3** dédiée à la recherche des noms scientifiques — ou noms binominaux — d’espèces animales, végétales ou autres dans un corpus de textes en se référant à une liste finie (mais, aussi exhaustive que possible). -**N.B.** : la liste et les textes doivent être en **UTF-8** (sans [BOM](https://fr.wikipedia.org/wiki/Indicateur_d%27ordre_des_octets)). +**N.B.** : la liste et les textes doivent être en **UTF-8** (sans [BOM](https://fr.wikipedia.org/wiki/Indicateur_d%27ordre_des_octets)). ### Nom binominal -Pour mémoire, en taxonomie, un nom binominal est formé de deux noms latins (ou latinisés) comprenant le nom de genre et le nom spécifique, comme “*Canis lupus*” pour le loup. Ce nom est normalement écrit en italique avec une initiale en majuscule pour le nom de genre et il peut être présent sous une forme abrégée où seule l'initiale du nom de genre est indiquée, comme “*C. lupus*”. À l'exception d'espèces très connues comme *Escherichia coli* qui est souvent simplement écrit *E. coli*, la forme abrégée ne doit être utilisée que si la forme longue est déjà apparue au moins une fois. De plus, si un nom de genre a été cité, toutes les espèces appartenant à ce même genre peuvent ensuite être citées sous forme abrégée, comme “*Canis lupus*, *C. latrans* et *C. aureus*” (pour “*Canis lupus*, *Canis latrans* et *Canis aureus*”). +Pour mémoire, en taxonomie, un nom binominal est formé de deux noms latins (ou latinisés) comprenant le nom de genre et le nom spécifique, comme “*Canis lupus*” pour le loup. Ce nom est normalement écrit en italique avec une initiale en majuscule pour le nom de genre et il peut être présent sous une forme abrégée où seule l'initiale du nom de genre est indiquée, comme “*C. lupus*”. À l'exception d'espèces très connues comme *Escherichia coli* qui est souvent simplement écrit *E. coli*, la forme abrégée ne doit être utilisée que si la forme longue est déjà apparue au moins une fois. De plus, si un nom de genre a été cité, toutes les espèces appartenant à ce même genre peuvent ensuite être citées sous forme abrégée, comme “*Canis lupus*, *C. latrans* et *C. aureus*” (pour “*Canis lupus*, *Canis latrans* et *Canis aureus*”). -Cependant, les formes abrégées peuvent être ambigües. Par exemples, on a deux espèces de poissons, *Cyprinus carpio* et *Carpiodes carpio*, qui ont la même abréviation : *C. carpio*. Pour éviter les erreurs, **IRC3sp** commence par faire la liste des noms de genre présents dans le document analysé pour obtenir l'ensemble des espèces présentes, et donc, des abréviations possibles. Malgré cela, si une ambigüité demeure, on considère comme valide le dernier nom de genre cité avant l'occurrence de la forme abrégée. +Cependant, les formes abrégées peuvent être ambigües. Par exemples, on a deux espèces de poissons, *Cyprinus carpio* et *Carpiodes carpio*, qui ont la même abréviation : *C. carpio*. Pour éviter les erreurs, **IRC3sp** commence par faire la liste des noms de genre présents dans le document analysé pour obtenir l'ensemble des espèces correspondantes dans la ressource, et donc, l’ensemble des abréviations possibles. Malgré cela, si une ambigüité demeure, on considère comme valide le dernier nom de genre cité *in extenso* avant l'occurrence de la forme abrégée. ### Usage + ``` - IRC3.pl -t table -r répertoire [ -e extension ]* [ -s fichier_sortie ] [ -l log ] [ -cq ] - IRC3.pl -t table -f fichier_entrée [ -s fichier_sortie ] [ -l log ] [ -cq ] - IRC3.pl -h + IRC3sp.pl -t table -r répertoire [ -e extension ]* [ -s fichier_sortie ] [ -l log ] [ -cq ] + IRC3sp.pl -t table -f (fichier_entrée|-) [ -s fichier_sortie ] [ -l log ] [ -cq ] + IRC3sp.pl -t table -j [ -f fichier_entrée ] [ -s fichier_sortie ] [ -l log ] [ -cq ] + IRC3sp.pl -h ``` + **N.B.** : contrairement à **IRC3**, cet outil a besoin d’avoir comme argument un fichier texte ou un répertoire de fichiers textes. Comme l’analyse du texte se fait en deux passes, **IRC3sp** ne peut pas lire les données sur l’entrée standard. +Dernièrement, le programme a été modifié pour pouvoir être utilisé par un *webservice*. Dans cette configuration, le programme est lancé par la commande suivante : + +``` + IRC3sp.pl -t table -p FIFO -w [ -l log ] [ -c ] +``` + ### Options + ``` - -c tient compte de la casse (majuscule/minuscule) des termes recherchés - (fortement recommandé) - -e indique l’extension (e.g. “.txt”) du ou des fichiers textes à traiter - (possibilité d’avoir plusieurs extensions en répétant l’option) - -f indique le nom du fichier texte à traiter - -h affiche cette aide + -c tient compte de la casse (majuscule/minuscule) des termes recherchés + -e indique l'extension (e.g. “.txt”) du ou des fichiers textes à traiter + (possibilité d’avoir plusieurs extensions en répétant l'option) + -f indique le nom du fichier texte à traiter (pour lire les données sur + l’entrée standard, utilisez un tiret “-” comme argument) + -h affiche cette aide + -j indique que les données en entrée, dans un fichier ou sur l’entrée standard, + sont en JSON ainsi que le résultat en sortie -l indique le nom du fichier récapitulatif où sera écrit pour chaque fichier - traité le nombre de termes et d’occurrences trouvés - -q supprime l’affichage de la progression du travail (notamment pour l’utiliser - dans un script shell) - -r indique le répertoire contenant les fichiers textes à traiter - -s indique le nom du fichier où sera écrit le résultat du traitement - -t indique le nom du fichier contenant la ressource, c’est-à-dire la liste - des termes à rechercher + traité le nombre de termes et d’occurrences trouvés + -p indique le nom du tube nommé (“named pipe”) ou FIFO utilisé pour transmettre + les données + -q supprime l’affichage de la progression du travail + -r indique le répertoire contenant les fichiers textes à traiter + -s indique le nom du fichier où sera écrit le résultat du traitement + -t indique le nom du fichier contenant la ressource, c'est-à-dire la liste + des termes à rechercher + -w indique que le programme est utilisé par un “webservice” qui modifie le fichier + envoyé en ne gardant que les objets JSON ``` +À noter que les options `-p` et `-w` ont été ajoutées pour permettre d’utiliser ce programme dans un *webservice*. Ne pas en tenir compte si vous travaillez en ligne de commande. + + ### Ressource -Le fichier de ressource contient un terme par ligne. Contrairement à **IRC3**, il est préférable de ne pas indiquer de forme préférentielle. +Le fichier de ressource contient un terme par ligne. On peut indiquer pour un terme sa forme préférentielle en ajoutant après le terme une ou plusieurs tabulations et le préférentiel. -Les lignes vides et celles commençant par le caractère “#” ne sont pas prises en compte. De plus, -la ressource peut être un fichier compressé par “gzip” ou “bzip2”. +Les lignes vides et celles commençant par le caractère “#” ne sont pas prises en compte. De plus, +la ressource peut être un fichier compressé par “gzip” ou “bzip2”. ### Résultat -Le fichier résultat contient une ligne par occurrence trouvée. Chaque ligne est formée suivant les cas de 3 ou 4 champs séparés par une tabulation. +Le fichier résultat contient une ligne par occurrence trouvée. Chaque ligne est formée de 5 champs séparés par une tabulation. On a respectivement le nom du fichier traité (“STDIN” dans le cas de l'entrée standard), le terme tel qu'il apparait dans le texte analysé, la forme abrégée du terme tel qu'il est dans la ressource si c’est une forme abrégée qui a été trouvée, le terme tel qu'il est dans la ressource et, dans le cas d'un synonyme, la forme préférentielle du terme. -Dans le cas où le nom trouvé dans le texte est la forme longue, on a 3 champs qui sont respectivement : +Le fichier résultat contient une ligne par occurrence trouvée. Chaque ligne est formée de 5 champs séparés par une tabulation. -* le nom du fichier traité, -* le nom binominal (forme longue) tel qu’il est dans la ressource, -* le nom binominal (forme longue) tel qu’il apparait dans le texte analysé, +On a respectivement : -Dans le cas où le nom est trouvé sous sa forme abrégée, on a 4 champs qui sont respectivement : +* le nom du fichier traité (“STDIN” dans le cas de l'entrée standard), +* le nom binominal (forme longue) tel qu’il apparait dans le texte analysé, +* le nom binominal (forme abrégée) généré par l’outil à partir de la ressource, +* le nom binominal (forme longue) tel qu’il est dans la ressource, +* le nom binominal (forme longue) de la forme préférentielle. -* le nom du fichier traité, -* le nom binominal (forme abrégée) généré par l’outil à partir de la ressource, -* le nom binominal (forme abrégée) tel qu’il apparait dans le texte analysé, -* le nom binominal (forme longue) tel qu’il est dans la ressource, - - +Évidemment, le troisième champ reste vide dans le cas où le nom trouvé n’est pas sous sa forme abrégée. De même, le cinquième champ reste vide si le nom d’espèce ou de sous-espèce n’a pas de forme préférentielle.