diff --git a/Dockerfile b/Dockerfile new file mode 100644 index 0000000..c3f402e --- /dev/null +++ b/Dockerfile @@ -0,0 +1,50 @@ +FROM inistcnrs/lodex-workers:9.2.3 AS build1 +#FROM golang:1.17.5-alpine3.15 as build2 + +# System setup +RUN apk update && \ + apk add git curl build-base autoconf automake libtool + +FROM node:14-alpine3.15 AS release +COPY --from=build1 /app /app +#COPY --from=build2 /export /usr +WORKDIR /app +# see .dockerignore to know all copied files +COPY ./config.json ./package-app.json ./chmod-all ./docker-entrypoint.sh /app/ +COPY ./public/requirements.txt ./public/IRC3sp.pl ./public/irc3sp.ini ./public/irc3_wrapper.sh ./public/CoL.txt /app/public/ +RUN apk add --update-cache --no-cache \ + su-exec \ + bash \ + git \ + openssh \ + build-base \ + cmake \ + openssl-dev \ + perl \ + perl-json \ + ca-certificates \ + rust \ + curl \ + tini \ + cargo \ + && \ + mv package-app.json package.json && \ + npm install --production && \ + npm cache clean --force && \ + npm prune --production && \ + echo '{ \ + "httpPort": 31976, \ + "configPath": "/app/config.json", \ + "dataPath": "/app/public" \ + }' > /etc/ezmaster.json && \ + sed -i -e "s/daemon:x:2:2/daemon:x:1:1/" /etc/passwd && \ + sed -i -e "s/daemon:x:2:/daemon:x:1:/" /etc/group && \ + sed -i -e "s/bin:x:1:1/bin:x:2:2/" /etc/passwd && \ + sed -i -e "s/bin:x:1:/bin:x:2:/" /etc/group && \ + mkdir -p /sbin/.npm /sbin/.config /sbin/.local && \ + chown -R daemon:daemon /app /tmp /sbin/.npm /sbin/.config /sbin/.local + +EXPOSE 31976 + +ENTRYPOINT ["/sbin/tini", "-g", "--"] +CMD [ "/app/docker-entrypoint.sh" ] diff --git a/README.md b/README.md new file mode 100644 index 0000000..56c1e23 --- /dev/null +++ b/README.md @@ -0,0 +1,16 @@ +# IRC3 + +Ce dépôt contient le trvaail pour créer une image Docker du web service IRC3 +pour [ezMaster](https://github.com/Inist-CNRS/ezmaster). + +Une fois qu'il sera stable, il est destiné à être intégré au monorepo des +[ezmaster-apps](https://github.com/Inist-CNRS/ezmaster-apps). + +Le _lodex-worker_ pris en exemple est +[lodex-workers-python](https://github.com/Inist-CNRS/ezmaster-apps/tree/main/applications/lodex-workers-python), +car il utilise aussi un autre langage de programmation que node, et embarque +moins de bibliothèques que +[lodex-workers-pytorch](https://github.com/Inist-CNRS/ezmaster-apps/tree/main/applications/lodex-workers-pytorch). + +Le programme IRC3 lui-même a été écrit et adapté aux espèces animales par +Dominique Besagni. diff --git a/chmod-all b/chmod-all new file mode 100755 index 0000000..7dd3873 --- /dev/null +++ b/chmod-all @@ -0,0 +1,7 @@ +#!/bin/sh +MODE=${1:?the first argument of the command should be an octal-mode.} +DIRECTORY=${2:?the second argument of the command should be a directory.} +( +flock -n 9 || exit 1 +find $DIRECTORY -exec ./chmod-one $MODE {} \; +) 9>./chmod-all.lock diff --git a/config.json b/config.json new file mode 100644 index 0000000..3d4e261 --- /dev/null +++ b/config.json @@ -0,0 +1,20 @@ +{ + "environnement": { + "EZS_TITLE": "lodex-workers-python", + "EZS_DESCRIPTION": "Web services Python for Lodex", + "EZS_METRICS": true, + "EZS_CONCURRENCY": 4, + "EZS_NSHARDS": 32, + "EZS_CACHE": true, + "NODE_OPTIONS": "--max_old_space_size=1024", + "NODE_ENV": "production" + }, + "packages": [ + "@ezs/spawn@1.1.0", + "@ezs/analytics@1.18.4", + "@ezs/basics@1.17.1" + ], + "files" : { + "#DISABLED zip": "https://gitbucket.inist.fr/tdm/web-services/archive/base-line/master.zip" + } +} diff --git a/docker-entrypoint.sh b/docker-entrypoint.sh new file mode 100755 index 0000000..954ea5e --- /dev/null +++ b/docker-entrypoint.sh @@ -0,0 +1,31 @@ +#!/bin/sh + +# installation des packges additionnels +PACKAGES_MEMORY="./packages.installed" +PACKAGES=$(node -e 'process.stdout.write(Array().concat(require("./config.json").packages).filter(Boolean).join(" ").trim())') + +touch ${PACKAGES_MEMORY} +PACKAGES_CHECK=$(cat ${PACKAGES_MEMORY}) +if [ -n "${PACKAGES}" ] && [ "${PACKAGES_CHECK}" != "${PACKAGES}" ] +then + npm install --production ${PACKAGES} + echo "${PACKAGES}" > ${PACKAGES_MEMORY} +fi + +# configuration +ZIP_URL=$(node -e 'process.stdout.write(Array().concat(require("./config.json").files.zip).filter(Boolean).pop()||"")') + +# récupération des fichiers +if [ -n "${ZIP_URL}" ] +then + /app/zipsyncdir "$ZIP_URL" +fi + +# Restauration du owner +find /app/public ! -user daemon -exec chown daemon:daemon {} \; & +find /tmp ! -user daemon -exec chown daemon:daemon {} \; & + +# lancement des daemons +/app/public/irc3_wrapper.sh start +npm run watcher & +exec su-exec daemon:daemon npm start diff --git a/package-app.json b/package-app.json new file mode 100644 index 0000000..8988fa0 --- /dev/null +++ b/package-app.json @@ -0,0 +1,34 @@ +{ + "private": true, + "name": "lodex-workers-perl", + "dependencies": { + "@ezs/analytics": "1.18.8", + "@ezs/basics": "1.21.0", + "@ezs/core": "1.29.0", + "@ezs/spawn": "^1.2.4", + "@ezs/storage": "1.6.3", + "dotenv-cli": "4.1.1", + "npm-watch": "0.11.0" + }, + "watch": { + "mod": { + "patterns": [ + "public" + ], + "extensions": "pl,pm,json,bin,ini,md", + "quiet": true, + "silent": true, + "verbose": false, + "ignore": [ + ".DAV" + ], + "runOnChangeOnly": false + } + }, + "scripts": { + "prestart": "node ./generate-dotenv.js", + "start": "cd ./public && dotenv -e ../.env -- ezs --daemon ./", + "watcher": "npm-watch", + "mod": "./chmod-all 755 ./public/" + } +} \ No newline at end of file diff --git a/package.json b/package.json new file mode 100644 index 0000000..63fa750 --- /dev/null +++ b/package.json @@ -0,0 +1,31 @@ +{ + "private": true, + "name": "lodex-workers-perl", + "version": "4.0.11", + "description": "Lodex workers for perl", + "repository": { + "type": "git", + "url": "git+https://github.com/Inist-CNRS/ezmaster-apps.git" + }, + "keywords": [ + "ezmaster" + ], + "author": "Nicolas Thouvenin ", + "license": "MIT", + "bugs": { + "url": "https://github.com/Inist-CNRS/ezmaster-apps/issues" + }, + "homepage": "https://github.com/Inist-CNRS/ezmaster-apps/tree/main/applications/lodex-workers-python#readme", + "scripts": { + "version:insert": "sed -i \"s#\\(${npm_package_name}.\\)\\([\\.a-z0-9]\\+\\)#\\1${npm_package_version}#g\" README.md && git add README.md", + "version:commit": "git commit -a -m \"release ${npm_package_name}@${npm_package_version}\"", + "version:tag": "git tag \"${npm_package_name}@${npm_package_version}\" -m \"${npm_package_name}@${npm_package_version}\"", + "version:push": "git push && git push --tags", + "version": "npm run version:insert && npm run version:commit && npm run version:tag", + "postversion": "npm run version:push && npm run build && npm run publish", + "build": "docker build -t inistcnrs/${npm_package_name}:${npm_package_version} .", + "prestart": "npm run build", + "start": "docker run --rm -p 31976:31976 inistcnrs/${npm_package_name}:${npm_package_version}", + "publish": "docker push inistcnrs/${npm_package_name}:${npm_package_version}" + } +} diff --git a/public/CoL.txt b/public/CoL.txt new file mode 100644 index 0000000..e932ff6 --- /dev/null +++ b/public/CoL.txt Binary files differ diff --git a/public/IRC3sp.pl b/public/IRC3sp.pl new file mode 100755 index 0000000..8b9710e --- /dev/null +++ b/public/IRC3sp.pl @@ -0,0 +1,1042 @@ +#!/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 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" . + " $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 -j [ -f fichier_entrée ] [ -s fichier_sortie ] [ -l log ] [ -cq ]\n" . + " $programme -t table -p FIFO [ -l log ] [ -c ]\n" . + " $programme -h\n\n"; + +my $version = "4.3.2"; +my $dateModif = "17 Août 2022"; + +my @table = (); +my %genre = (); +my %liste = (); +my %pref = (); +my %str = (); + +# Initialisation des variables globales +# nécessaires à la lecture des options +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 $top = undef; +my @extensions = (); +my $recherche = 0; +# Getopt::Long::Configure("no_ignore_case"); +# Getopt::Long::Configure("bundling"); + +eval { + $SIG{__WARN__} = sub {usage(1);}; + GetOptions( + "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, + ); + }; +$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 (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 "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 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 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 and not $json and not $fifo; + +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'} = '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; + +while () { + 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 =~ /^(\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}}, $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 $pref =~ m|^\p{IsWord}-?\Z| ) { + print STDERR "Préférentiel refusé : \"$pref\"\n"; + next; + } + $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 =~ /^(\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; + } + } +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" ; + } + +if ( $fifo ) { + # $quiet = 0; + $json = undef; + $sortie = undef; + my $retour = undef; + + 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; + ($json, $retour) = passe1($json); + print OUT $json; + close OUT; + $json = undef; + } + elsif ( $sortie ) { + $json .= $_; + } + elsif ( /^%% STOP IRC3/o ) { + unlink $fifo; + exit 0; + } + } + close INP; + } + nettoie(); + exit 2; + } + +select(STDERR); +$| = 1; +select (STDOUT); + +if ( $sortie ) { + open(OUT, ">:utf8", $sortie) or die "$!,"; + select OUT; + } + +if ( $json ) { + if ( $fichier ) { + traite_json($fichier); + } + else { + traite_json('-'); + } + } +elsif ( $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"); + } + } + +nettoie(); + + +exit 0; + + +sub usage +{ +print STDERR "\n$usage"; + +exit shift; +} + +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() { + # 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; + } + +@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; + 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] ) { + if ( $champs[2] =~ /^\?.+\?\z/o ) { + push(@ambigus, $item); + } + else { + $especes{$champs[2]} ++; + } +# } +# else { +# $especes{$champs[0]} ++; +# } + } + } + my @especes = sort keys %especes; + if ( @especes ) { + $tmp .= " \"species\": [\n"; + while (my $item = shift @especes) { + $tmp .= " \"$item\""; + $tmp .= "," if @especes; + $tmp .= "\n"; + } + $tmp .= " ]\n"; + } + else { + $tmp .= " \"species\": []\n"; + } + $tmp .= " }"; + push(@tmp, $tmp); + } +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 %tmp = (); +my @tmp1 = sort grep {not $tmp{$_} ++;} @liste; +my @tmp2 = (); +%tmp = (); + +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(/^$genre\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); + 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"; + my $str = join(" ", grep(/\P{IsSpace}/, split(/(\P{IsWord})/, $abrev))); + push(@tmp2, $str); + $tmpStr{$str} = $abrev; + if ( $tmpPref{$str} ) { + $tmpPref{$str} .= " ; $str{$terme}"; + } + else { + $tmpPref{$str} = $str{$terme}; + } + } + } + else { + # 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; + } + else { + print STDERR "Pas de forme canonique pour \"$terme\"\n"; + next; + } + if ( $terme =~ /^(\p{IsLower})\P{IsSpace}+\p{IsSpace}+(.+)/o ) { + my $abrev = "$1. $2"; + 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; + } + } + } + } +%tmp = (); +@tmp1 = sort grep{not $tmp{$_} ++;} @tmp2; + +@liste = (); +%tmp = (); + +# On point sur les nouveaux hachages ... +$prefRef = \%tmpPref; +$strRef = \%tmpStr; + +foreach my $para (@para) { + push(@liste, recherche($id, $para, \@tmp1)); + } + +# Traitement des ambigüités toujours présentes +@tmp1 = grep{not $tmp{$_} ++;} grep(/\t\?.+\?\z/, @liste); +if ( @tmp1 ) { + @tmp2 = grep(!/\t\?.+\?\z/, @liste); + 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 (@liste) { + 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 (@liste) { + 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 <= $#liste ; $n ++ ) { + if ( $liste[$n] eq $item ) { + for ( my $m = $n ; $m >= 0 ; $m -- ) { + my ($terme) = $liste[$m] =~ /^(.+?)\s/o; + next if not $genre{$terme}; + if ( $tmp{$terme} ) { + @tmp = grep(/^$terme /, @tmp3); + if ( $#tmp == 0 ) { + foreach my $resultat (@liste) { + if ( $resultat eq $item ) { + $resultat = "$t1\t$t2\t$tmp[0]"; + } + } + } + } + } + } + } + } + } + + +# ... et retour aux hachages par défaut. +$prefRef = \%pref; +$strRef = \%str; + +@tmp1 = (); + +while( my $resultat = shift @liste ) { + my @champs = split(/\t/, $resultat); + next if $genre{$champs[0]}; + if ( $champs[2] ) { + $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]} ++; + } + } + 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, $id; + +return @tmp1 if $json; +} + +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); + 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/go; + $terme =~ s/\\ /\\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; + 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 { + $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 { + $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 nettoie +{ +if ( $fifo and -p $fifo ) { + unlink $fifo; + } +if ( not $quiet ) { + print STDERR "\r", " " x 75, "\r"; + print STDERR "\n"; + } + +exit 0; +} diff --git a/public/irc3_wrapper.sh b/public/irc3_wrapper.sh new file mode 100755 index 0000000..d506021 --- /dev/null +++ b/public/irc3_wrapper.sh @@ -0,0 +1,89 @@ +#!/bin/bash + + +# Initialisation des variables pour les options +programme=$(basename $0) +version='0.1.3' +modif='17 Août 2022' + +function usage +{ +echo "Usage : $programme (start|job|stop) " +echo " $programme help " +} + +function aide +{ +cat << EOT + +Usage +===== + $programme (start|job|stop) + $programme help + +Options +======= + help affiche cette aide + job envoie les données au programme “IRC3sp.pl” + start lance le programme “IRC3sp.pl” en mode “nohup” + stop arrête le programme “IRC3sp.pl” + +EOT + +exit 0 +} + +function lance_irc3 +{ +nohup /app/public/IRC3sp.pl -t /app/public/CoL.txt -p /tmp/fifo_irc3 -c & #> /dev/null & +} + +function arrete_irc3 +{ +if [[ -p /tmp/fifo_irc3 ]] +then + echo "%% STOP IRC3" > /tmp/fifo_irc3 +fi +} + +function travail +{ +if [[ -p /tmp/fifo_irc3 ]] +then + mkfifo -m 0666 /tmp/fifo_job_$$ + + (echo "%% JOB POUR FIFO /tmp/fifo_job_$$"; + cat; + echo ""; + echo "%% FIN JOB") > /tmp/fifo_irc3 + + cat /tmp/fifo_job_$$ + rm -f /tmp/fifo_job_$$ +fi +} + +trap 'if [[ -f /tmp/fifo_job_$$ ]]; then echo ok; fi' HUP INT TERM EXIT +# Options +if [[ -z $1 ]] +then + echo " " + usage + exit 1 +else + if [[ $1 = "help" ]] + then + aide + elif [[ $1 = "start" ]] + then + lance_irc3 + elif [[ $1 = "stop" ]] + then + arrete_irc3 + elif [[ $1 = "job" ]] + then + travail + fi +fi + + +exit 0 diff --git a/public/irc3sp.ini b/public/irc3sp.ini new file mode 100644 index 0000000..5c0b872 --- /dev/null +++ b/public/irc3sp.ini @@ -0,0 +1,39 @@ +# OpenAPI Documentation - JSON format (dot notation) +post.responses.default.description = Return all objects with new data, i.e. species and subspecies names +post.responses.default.content.application/json.schema.$ref = #/components/schemas/JSONStream +post.summary = Enrich one field of each Object with a Perl function +post.requestBody.required = true +post.requestBody.content.application/json.schema.$ref = #/components/schemas/JSONStream +post.parameters.0.in = query +post.parameters.0.name = path +post.parameters.0.schema.type = string +post.parameters.0.description = The path in each object to enrich with a Perl script +post.parameters.1.in = query +post.parameters.1.name = indent +post.parameters.1.schema.type = boolean +post.parameters.1.description = Indent or not the JSON Result + +[use] +plugin = @ezs/spawn +plugin = @ezs/basics +plugin = @ezs/storage +plugin = @ezs/analytics + +[JSONParse] +legacy = false +separator = $ + +[expand] +path = env('path', 'value') +size = 100 +# in production mode, uncomment the following line +# cache = boost + +[expand/exec] +# command should be executable ! +#command = ./irc3_wrapper.sh +command = /app/public/irc3_wrapper.sh +args = job + +[dump] +indent = env('indent', false) diff --git a/public/requirements.txt b/public/requirements.txt new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/public/requirements.txt