diff --git a/01-alignement/README.md b/01-alignement/README.md new file mode 100644 index 0000000..adfc5e9 --- /dev/null +++ b/01-alignement/README.md @@ -0,0 +1,242 @@ +Alignement Pascal-Francis / Istex +=============== + +Programme d’alignement des notices bibliographiques Inist avec les documents Istex + +Le programme `matchStan2Istex.pl` permet d’aligner les bases bibliographiques Pascal et Francis de l’**Inist** avec la base **Istex**, c’est-à-dire retrouver dans la base Istex les documents correspondants aux notices bibliographiques des base Pascal ou Francis. + +À noter que si ce programme est utilisé à l'Inist, il est recommandé d’éviter de passer par le proxy. Pour cela, il faut supprimer les variables globales le définissant, ce qui se fait avec la commande  : `unset http_proxy https_proxy no_proxy`. Vérifiez également avec la commande `env` si ces mêmes variables n'existent pas en majuscule. Auquel cas, supprimez les avec la commande : `unset HTTP_PROXY HTTPS_PROXY NO_PROXY`. + + +### Prérequis + +Le programme `matchStan2Istex.pl` fonctionne sous Unix/Linux ainsi qu’avec Cygwin sous Windows. Il utilise plusieurs modules qui ne sont pas tous dans la distribution standard de **Perl**. Les modules qu’on peut être amené à installer sont : + + - HTML::Entities + - HTTP::CookieJar::LWP + - JSON + - LWP::userAgent + - Number::Convert::Roman + - Text::Unidecode + - URI::Encode + +Il peut aussi être nécessaire d’avoir le programme `IhfdCat` pour accéder aux notices **Inist** i eles sont dans un fichier **HFD** (voir [divers](../../../tree/master/divers)). + + +### Usage + +```txt + matchStan2Istex.pl -f (fichier|-) [ -d ] [ -v nombre ] [ -r id ] + [ -n notices ] [ -c corpus[,corpus]* ]* + matchStan2Istex.pl -h fichier_HFD [ -d ] [ -v nombre ] [ -r id ] + [ -n notices ] [ -c corpus[,corpus]* ]* + matchStan2Istex.pl -i +``` + + +### Options + +``` + -c indique le nom du ou des corpus de la base Istex à interroger (on peut soit répéter + cette option, soit mettre tous les noms de corpus séparés par des virgules, mais sans + espace) + -d active le mode “débogage” + -f indique le nom du fichier d’entrée (qui peut être un fichier compressé avec “gzip” ou + “bzip2”). Pour utiliser l’entrée standard, mettre un tiret “-” + comme argument + -h indique le nom du fichier HFD servant d’entrée au programme + -i affiche cette aide. + -n indique le nom du fichier contenant les notices Pascal ou Francis modifiées parce + que les notices originales provoquaient une erreur de syntaxe dans la requête à l’API + ISTEX (N.B. : l’absence du fichier indiqué n’entraîne pas l’arrêt du programme) + -r indique le numéro de la dernière notice Pascal ou Francis traitée précédemment, pour + permettre la reprise de l’alignement si celui-ci a été prématurément arrêté + -v permet de suivre la progression du traitement en affichant sur la sortie erreur l’heure + de début, l’heure de fin et l’heure chaque fois qu’un lot de notices, correspondant au + nombre de notices donné en argument, a été traité +``` + + +### Formats d’entrée et de sortie + +#### 1 - Notices Inist + +Les notices bibliographiques des bases Pascal et Francis sont des documents balisés en [SGML](https://fr.wikipedia.org/wiki/Standard_Generalized_Markup_Language) (norme ISO 8879:1986). Chaque notice est sur une seule ligne et à chaque balise ouvrante correspond une balise fermante. En dehors des lettres majuscules et minuscules non-accentuées, des chiffres et des signes de ponctuation de base, les caractères sont écrits sous forme d’entité caractère (par exemple, `é` pour le caractère `é`). À l’inverse de ce qu’on peut trouver dans [XML](https://fr.wikipedia.org/wiki/Extensible_Markup_Language) (qui est un sous-ensemble de SGML), les valeurs d’attribut ne sont pas entre *quotes*, simples ou doubles et il n'y a pas de balise vide. + +La racine du document est l’élément `record` et il y a deux niveaux de balise correspondant aux zones et sous-zones du format d’échange de notices bibliographiques de la norme [ISO 2709](https://fr.wikipedia.org/wiki/ISO_2709) comme on peut le voir dans l’exemple ci-dessous (indenté par souci de lisibilité). La sémantique des noms de zone, préfixés par `f` en SGML, des noms de sous-zone, préfixés par `s` en SGML, et de l’attribut `dir` est défini dans le document « Format INIST Standard 1994 ». + +```sgml + + + 0138-9130 + + + SCNTDX + + + Scientometrics : (Print) + + + 72 + + + 2 + + + Profiling citation impact : A new methodology + + + ADAMS (Jonathan) + + + GURNEY (Karen) + + + MARSHALL (Stuart) + + + Evidence Ltd + Leeds + GBR + 1 aut. + 2 aut. + 3 aut. + + ... + + Aide décision + 18 + + + Decision aid + 18 + + + Ayuda decisión + 18 + + + 203 + + +``` + +#### 2 - Sortie standard + +##### Cas général + +Pour chaque notice Inist traitée, et sauf pour 2 exceptions que l’on verra plus loin, on a une première ligne commençant par `URI` et indiquant la requête envoyée à l’API. La ligne suivante donne le nombre de réponses obtenues. + +```txt +URI : "https://api.istex.fr/document/?q=(host.title:"Scientometrics" OR host.issn:"0138-9130" OR host.eissn:"0138-9130" +OR serie.issn:"0138-9130" OR serie.eissn:"0138-9130") AND (publicationDate:2007 OR copyrightDate:2007 OR host.publicationDate:2007 +OR host.copyrightDate:2007 OR serie.publicationDate:2007 OR serie.copyrightDate:2007 OR host.volume:72 OR host.issue:2) AND +(author.name:("ADAMS" OR "GURNEY" OR "MARSHALL") OR host.pages.first:[325 TO 344] OR host.pages.last:[325 TO 344]) +&output=title,author,host,serie,doi,publicationDate,copyrightDate" + => 68 +``` + +On peut ensuite trouver d’autres requêtes commençant par `ALT`, `ETC` ou `RAC`. Ces requêtes complémentaires servent soit à tester une autre stratégie de recherche (`RAC`), soit à essayer différentes valeurs pour la pagination (`ETC`) ou soit à rechercher un groupe de documents indexés dans une seule notice Inist (`ALT`). Les requêtes de type `ETC` et `RAC` sont suivies d’une ligne indiquant le nombre de réponse renvoyées par l¹API. + +Dans le cas le plus général, on a ensuite le résultat sur une ligne avec 22 champs, pas toujjours remplis, séparés par des tabulations. On a respectivement : + - une note exprimée à l’aide d’astérisques (1 étoile) et de signes plus (½ étoile), de `*****` à `0` + - le score, de `5.000` à `0.000`, parfois suivi d’un point d’exclamation `!` + - le niveau bibliographique : `A` pour un article et `M` pour une monographie + - le numéro Inist de la notice + - le titre du document + - le nom de la revue + - le titre de la monographie + - ISSN + - ISBN + - l’année de publication + - le n° de volume + - le n° de fascicule + - la page de début + - la page de fin + - le nom du premier auteur + - le prénom du premier auteur + - la liste des auteurs suivants séparés par une barre verticale `|` + - l’identifiant Istex + - l’identifiant pérenne ARK + - l’identifiant DOI + - l’identifiant PII + - l’identifiant PMID + +Dans l’exemple suivant, on a rajouté un signe d’exclamation aux champs vides pour permettre de les repérer. + +```txt +***** 5.000 A 08-0322753 Profiling citation impact : A new methodology Scientometrics ! 0138-9130 ! +2007 72 2 325 344 ADAMS Jonathan GURNEY, Karen|MARSHALL, Stuart 16AA6F7A70CD152792DC04F6D65A673B8B7F2214 +ark:/67375/VQC-DZRDKVN2-2 10.1007/s11192-007-1696-x ! ! +``` + +On considère que l'alignement est bon si le score est supérieur ou égal à `3.490`. Pour les scores inférieurs à cette valeur, on a parfois un point d’exclamation `!` qui indique que les données bibliographiques sur la revue, l’année de publication, la volumaison, la tomaison (si elle existe) et la pagination sont correctes, mais que le reste des données ne correspond pas. Cela peut être dû à des fautes de frappe ou d’OCR dans les noms d’auteur ou dans le titre, ou cela peut être dû à une erreur de bulletinage : le document s'est vu attribuer par exemple la pagination d’un autre article du même fascicule. On trouve de tels décalages aussi bien dans les données Inist que dans celles des éditeurs. + +##### Messages divers + +On peut aussi avoir des messages, pas forcément d’erreur, après la requête. Ils sont précédés d’une flèche, ont un texte en majuscule et se terminent par un point d’exclamation, comme `=> CORRECTION MAC !`. Ils indiquent un traitement particulier et ont servi à perfectionner le programme. + +Les véritables erreurs sont indiquées comme telles. Ont a 3 types d’erreur : + + - requête incorrecte `=> ERREUR 400 "400 Bad Request" !` + - problème de connexion au serveur `=> ERREUR 500 "500 Internal Server Error" !` + - mauvaise conversion de JSON vers Perl `=> ERREUR CONVERSION JSON -> PERL !` + +La première est due aux données de la notice Inist. En utilisant les notices corrigées, cela ne devrait plus arriver. Les deux autres sont des problèmes temporaires qu'on peut corriger avec le programme `recupErreurs.pl` dans le répertoire “**correction**”. + +##### Notices groupées + +Certaines notices Inist concernent non pas un article, mais un groupe d’articles pour différentes raisons : + + - “Pro and con” : en médecine, deux auteurs (ou groupes d’auteurs) discutent d’un sujet, comme une procédure médicale, et un auteur est pour, l’autre est contre. + - juste à la suite d’un article, on a un commentaire d’un autre auteur, voire la réponse du premier auteur aux commentaires sur son article. + - plusieurs articles associés, déjà regroupés dans le fascicule et traitant du même sujet. + +Les différents articles pouvant être regroupés sont indiqués après le résultat général. Pour chaque article, on a une flèche ` ~~> ` suivie de 7 champs séparés par des tabulations. On a respectivement : + + - la première page + - la dernière page + - la liste des auteurs séparés par une barre verticale `|` + - le titre de l’article + - l’identifiant Istex + - l’identifiant pérenne ARK + - l’identifiant DOI + +Ces document sont présentés normalement dans l’ordre de la pagination, comme dans cet exemple article/commentaires/réponses. + +```txt + ~~> 2 10 I. P. Stolerman|M. J. Jarvis The scientific case that nicotine is addictive 5A8E718F07659D84B0480F8D78D661F0E17ECAC6 ark:/67375/1BB-TFLHTXVC-4 10.1007/BF02245088 + ~~> 11 13 J. E. Henningfield|S. J. Heishman The addictive role of nicotine in tobacco use B16BD3EAB82D95F6780752DAEC1ABB1E1FAA27BF ark:/67375/1BB-3ZB0VPRG-6 10.1007/BF02245089 + ~~> 14 15 S. Shiffman Comments on nicotine addiction 79BF81FCD57EECD784BC85C823992173162BE5C1 ark:/67375/1BB-QWBZ3DS5-C 10.1007/BF02245090 + ~~> 16 17 J. H. Robinson|W. S. Pritchard Reply to stolerman and jarvis 70F7FD3CA45D99F42EAD372FF607CAC82376B7EA ark:/67375/1BB-0KBPPP8C-F 10.1007/BF02245091 + ~~> 18 20 M. E. Jarvik Commentary DC536BE3D44EEC8BCA32DCFE79FE23590494CA35 ark:/67375/1BB-JZ3PB2LS-Z 10.1007/BF02245092 + ~~> 21 22 J. H. Jaffe Commentary on the nicotine IS/IS not addictive debate 5B0620646FBF8A3785C50F3597709ED9B25DA216 ark:/67375/1BB-XFHN05CC-V 10.1007/BF02245093 +``` + +##### Exceptions + +Dans deux cas, on n’a pas de requête, mais seulement un résultat nul : pour les monographies et pour les articles dont la revue n’est pas dans la base Istex. Dans le premier cas, la note est un *underscore* `_`, le score est un tiret `-` et le niveau bibliographique est `M`. Dans le deuxième cas, on a le même résultat que lorsque l’API n’a trouvé aucun document, mais sans la requête. En fait, au premier article d’une revue, on teste la présence de cette revue dans la base. Si la réponse est nulle, tous les autres articles de la même revue ne font l’objet d’aucune recherche inutile. + +#### 3 - Erreur standard + +En cas d’utilisation de l’option `-v`, le programme envoie par la sortie “erreur standard” des messages sur le travail en cours. On a : + - le nom du programme et sa version (sauf dans les anciennes versions du programme) + - en cas de reprise d’un travail interrompu, le n° de la dernière notice Inist + - le nom du fichier traité ou la mention `entrée standard` + - la date et l’heure de début du traitement + - la date et l’heure auxquelles on a terminé un lot de notices correspondant à la valeur de l’option `-v` + - la date te l’heure de fin de traitement avec rappel du nombre de notices traitées + +```txt +==> matchStan2Istex.pl, version 14.3.2 (24 Août 2020) +*** Notices traitées : 2008/Pascal.strd08.bib *** + -> Mardi 29 Septembre 2020 03:27:56 : début + -> Mardi 29 Septembre 2020 03:29:47 : 10000 notices + -> Mardi 29 Septembre 2020 03:31:13 : 20000 notices + -> Mardi 29 Septembre 2020 03:32:59 : 30000 notices + ... + -> Mardi 29 Septembre 2020 04:45:50 : 480000 notices + -> Mardi 29 Septembre 2020 04:47:26 : 490000 notices + -> Mardi 29 Septembre 2020 04:48:35 : fin = 497745 notices +``` + diff --git a/01-alignement/matchStan2Istex.pl b/01-alignement/matchStan2Istex.pl new file mode 100755 index 0000000..6b43b4f --- /dev/null +++ b/01-alignement/matchStan2Istex.pl @@ -0,0 +1,3082 @@ +#!/usr/bin/perl + + +# Déclaration des pragmas +use strict; +use utf8; +use open qw/:std :utf8/; +## use warnings::unused; +## use warnings 'once'; + +# Appel des modules externes de base +use Encode; +use Getopt::Long; + +# Appel des modules spécifiques à l'application +use HTML::Entities qw(decode_entities %entity2char); +use HTTP::CookieJar::LWP; +use JSON; +use LWP::UserAgent; +use Number::Convert::Roman; +use Text::Unidecode; +use URI::Encode qw(uri_encode uri_decode); + +my ($programme) = $0 =~ m|^(?:.*/)?(.+)|; +my $substitut = " " x length($programme); +my $version = "15.3.1"; +my $dateModif = "4 Octobre 2021"; + +my $usage = "Usage : \n" . + " $programme -f (fichier|-) [ -d ] [ -v nombre ] [ -r id ] \n" . + " $substitut [ -n notices ] [ -c corpus[,corpus]* ]* \n" . + " $programme -h fichier_HFD [ -d ] [ -v nombre ] [ -r id ] \n" . + " $substitut [ -n notices ] [ -c corpus[,corpus]* ]* \n" . + " $programme -i \n"; + +my $debug = undef; +my $fichier = undef; +my $hfd = undef; +my $info = undef; +my $notices = undef; +my $reprise = undef; +my $verbeux = undef; +my @corpus = (); + +eval { + $SIG{__WARN__} = sub {usage(1);}; + GetOptions( + "corpus=s" => \@corpus, + "notices=s" => \$notices, + "info" => \$info, + "debug" => \$debug, + "fichier=s" => \$fichier, + "hfd=s" => \$hfd, + "reprise=s" => \$reprise, + "verbeux=i" => \$verbeux, + ); + }; +$SIG{__WARN__} = sub {warn $_[0];}; + +if ( $info ) { + print "Programme : \n"; + print " “$programme”, version $version ($dateModif)\n"; + print " Permet de chercher les correspondances entre les notices bibliographiques des bases Pascal \n"; + print " et Francis de l’INIST et les documents de la base ISTEX. \n"; + print "\n"; + print $usage; + print "\nOptions : \n"; + print " -c indique le nom du ou des corpus de la base ISTEX à interroger (on peut soit répéter \n"; + print " cette option, soit mettre tous les noms de corpus séparés par des virgules, mais sans \n"; + print " espace) \n"; + print " -d active le mode “débogage” \n"; + print " -f indique le nom du fichier d’entrée (qui peut être un fichier compressé avec “gzip” ou \n"; + print " “bzip2”). Pour utiliser l’entrée standard, mettre un tiret “-” \n"; + print " comme argument \n"; + print " -h indique le nom du fichier HFD servant d’entrée au programme \n"; + print " -i affiche cette aide. \n"; + print " -n indique le nom du fichier contenant les notices Pascal ou Francis modifiées parce \n"; + print " que les notices originales provoquaient une erreur de syntaxe dans la requête à l’API \n"; + print " ISTEX (N.B. : l’absence du fichier indiqué n’entraîne pas l’arrêt du programme) \n"; + print " -r indique le numéro de la dernière notice Pascal ou Francis traitée précédemment, pour \n"; + print " permettre la reprise de l’alignement si celui-ci a été prématurément arrêté \n"; + print " -v permet de suivre la progression du traitement en affichant sur la sortie erreur l’heure \n"; + print " de début, l’heure de fin et l’heure chaque fois qu’un lot de notices, correspondant au \n"; + print " nombre de notices donné en argument, a été traité \n"; + print " \n"; + print "N.B. : pour ne pas passer par le proxy sur le réseau interne de l’INIST, il faut effacer les \n"; + print " variables globales du proxy par la commande “unset http_proxy https_proxy no_proxy” \n"; + print " avant de lancer le programme “$programme”. \n"; + print " Également, l’absence du fichier donné par l’option “-n” n’entraîne pas l’arrêt du \n"; + print " programme, seulement un message d’erreur. \n"; + print " \n"; + + exit 0; + } + +usage(2) if not $fichier and not $hfd; +usage(2) if $fichier and $hfd; + +if ( @corpus ) { + @corpus = split(/,/, join(",", @corpus)); + } + +if ( $verbeux ) { + if ( $verbeux < 0 ) { + print STDERR "\n$programme : l’option “-v” doit être un entier positif !\n"; + exit(3); + } + } + +# Complétion de la table des entitées HTML +while() { + next if /^\s*$/o or /^#/o; + chomp; + my ($num, $sgml) = split(/\t+/); + next if $entity2char{$sgml}; + $entity2char{$sgml} = chr($num); + } +close DATA; + +# Paramètres de l'API ISTEX +my $base = "https://api.istex.fr"; +my $url = "$base/document/?q="; +my $out = "output=author,copyrightDate,doi,host,pii,pmid,publicationDate,serie,title"; +my $size = 100; +my $echec = 0; + +# Initialisation de l'agent +my $agent = LWP::UserAgent->new( + cookie_jar => HTTP::CookieJar::LWP->new, + ); +$agent->agent("$programme/$version"); +$agent->default_header("Accept" => "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"); +$agent->default_header("Accept-Language" => "fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3"); +$agent->default_header("Accept-Encoding" => "gzip, deflate"); +$agent->default_header("Connection" => "keep-alive"); + +# Allongement du temps d'attente +$agent->timeout(300); +$agent->env_proxy; + +# Déclaration des variables concernant la notice à chercher +my $date = ""; +my $fascicule = ""; +my $isbn = ""; +my $issn = ""; +my $journal = ""; +my $label = ""; +my $livre = ""; +my $nivbib = ""; # Niveau bibliographique (A, M ou C); +my $nom1 = ""; # Nom du premier auteur +my $num = ""; +my $pagedebut = ""; +my $pagefin = ""; +my $prenom1 = ""; # Prénom du premier auteur +my $titre = ""; +my $volume = ""; +my @autres = (); # Auteurs (autres que le premier auteur) +my @isbns = (); +my @issns = (); +my @journaux = (); +my @langues = (); +my @livres = (); +my @pages = (); +my @titres = (); +my %modifs = (); +my %notice = (); +my %pages = (); +my %pb = (); +my %rdvfp = (); +my %source = (); + +# Déclaration d'un hachage général pour éviter de répéter les +# messages plusieurs fois pour la même notice +my @alertes = (); +my %alerte = (); + +# Nombre de notices traitées +my $notice = 0; + +# Initialisation du convertisseur de chiffres romains +my $convert = Number::Convert::Roman->new; + +# Sortie sans “buffer” +select STDERR; +$| = 1; +select STDOUT; +$| = 1; + +# Récupération des notices alternatives du fichier indiqué +# par l’option “- a” +if ( $notices ) { + if ( -f $notices ) { + open(INP, "<:raw", $notices) or die "$!,"; + while() { + next if /^\s*$/o or /^#/o; + ($num) = m|(.+?)|o; + $notice{$num} = $_; + } + close INP; + if ( $verbeux ) { + print STDERR "*** Fichier de notices corrigées : $notices *** \n"; + } + } + elsif ( $verbeux ) { + print STDERR "*** Fichier de notices corrigées “$notices” absent *** \n"; + } + } + +if ( defined $fichier ) { + if ( $fichier eq '-' ) { + open(INP, "<&STDIN") or die "$!,"; + binmode(INP, ":raw"); + } + elsif ( $fichier =~ /\.gz\z/o ) { + open(INP, "gzip -cd $fichier |") or die "$!,"; + binmode(INP, ":raw"); + } + elsif ( $fichier =~ /\.bz2\z/o ) { + open(INP, "bzip2 -cd $fichier |") or die "$!,"; + binmode(INP, ":raw"); + } + else { + open(INP, "<:raw", $fichier) or die "$!,"; + } + } +elsif ( defined $hfd ) { + open(INP, "IhfdCat $hfd |") or die "$!,"; + binmode(INP, ":raw"); + } + +if ( $verbeux ) { + print STDERR "==> $programme, version $version ($dateModif) <== \n"; + if ( $reprise ) { + print STDERR "*** Reprise du traitemment après la notice \"$reprise\" *** \n"; + } + else { + if ( defined $hfd ) { + print STDERR "*** Notices traitées : $hfd *** \n"; + } + elsif ( defined $fichier ) { + if ( $fichier eq '-' ) { + print STDERR "*** Notices traitées : entrée standard *** \n"; + } + else { + print STDERR "*** Notices traitées : $fichier *** \n"; + } + } + my $moment = date(); + print STDERR " -> $moment : début\n"; + } + } + +if ( defined $reprise ) { + while() { + next if /^\s*$/o; + # Recherche du numero de notice. + ($num) = m|(.+?)|o; + $notice ++; + if ( $num eq $reprise ) { + if ( $verbeux ) { + my $moment = date(); + print STDERR " -> $moment : reprise = $notice notices\n"; + } + last; + } + } + } + +# Modification de l’URL de base si la requête est restreinte à un +# (ou plusieurs) corpus plutôt qu’à l’ensemble de la base ISTEX +if ( @corpus ) { + if ( $#corpus == 0 ) { + $url .= "corpusName:$corpus[0]+AND+" + } + else { + $url .= "corpusName:(" . join("+", @corpus) . ")+AND+" + } + } + +while() { + next if /^\s*$/o; + next if /^#/o; + + # Message pour chaque "$verbeux" notices traitées + $notice ++; + if ( $verbeux and $notice % $verbeux == 0 ) { + my $moment = date(); + print STDERR " -> $moment : $notice notices\n"; + } + + # Remise à zéro des alertes + %alerte = (); + + # Recherche du niveau bibbliographique. + ($nivbib) = m|([AMC])|o; + + # Recherche du numero de notice. + ($num) = m|(.+?)|o; + if ( not $num ) { + print STDERR "pas de numéro INIST pour la notice #$notice\n"; + next; + } + + + if ( $notice{$num} ) { + $_ = $notice{$num}; + } + + # Prétraitement de la notice avant découpe + chomp; + s/\r//o; + s|||o; + # Problème de l'entité "&dquot;" et des trémas + s/&dquot;/"/go; + s/&(\w)\.die;/&${1}uml;/go; + s/&Lstok;/Ł/go; + + # Découpe des champs. + my @champs = split(/(.+?)|o; + push(@langues, $langue); + } + + # Recherche du titre en fonction du niveau bib. + $titre = ""; + if ( $nivbib eq "A" ) { + my @titres = grep(/^A[06]8 /, @champs); + ($titre) = $titres[0] =~ m|(.+?)|o; + } + elsif ( $nivbib eq "M" ) { + my @titres = grep(/^A[06]9 /, @champs); + ($titre) = $titres[0] =~ m|(.+?)|o; + } + elsif ( $nivbib eq "C" ) { + my @titres = grep(/^A[17]0 /, @champs); + ($titre) = $titres[0] =~ m|(.+?)|o; + } + else { + print STDERR "Attention : pas de titre pour notice n° $num, ligne $.\n"; + } + # On pense à mettre le titre INIST en UTF-8, mais une seul fois + $titre = decode_entities($titre); + + # Recherche du titre de journal. + my @tmp = (); + my %tmp = (); + $journal = ""; + @journaux = grep(/^A64 /, @champs); + if ( $#journaux == -1 ) { + @journaux = grep(/^A03 /, @champs); + } + foreach my $item (@journaux) { + ($journal) = $item =~ m|(.+?)|o; + push(@tmp, $journal); + } + @journaux = grep(/./, @tmp); + foreach my $item (@journaux) { + if ( $item =~ /^([A-Z]{3,})\. (\p{isUpper}(\p{isAlpha}|&\w+;)+.*)/o ) { + push(@journaux, $1); + push(@journaux, $2); + } + $item =~ s/ : .*//o; + $item =~ s/^\s*\(([^)]+)\) +/$1 /o; + $item =~ s/^(.+) +\(([^)]+)\)\s*\z/$2 $1/o; + if ( $tmp{$item} ) { + $item = ""; + } + else { + $tmp{$item} ++; + } + } + @journaux = grep(/./, @journaux); + if ( $#journaux >= 0 ) { + $journal = $journaux[0]; + } + + # Recherche du titre du livre. + %tmp = (); + $livre = ""; + @livres = grep(/^A09 /, @champs); + foreach my $item (@livres) { + ($livre) = $item =~ m|(.+?)|o; + if ( $tmp{$livre} ) { + $item = ""; + } + else { + $item = $livre; + $tmp{$livre} ++; + } + } + @livres = grep(/./, @livres); + if ( $#livres >= 0 ) { + $livre = $livres[0]; + } + + # Recherche de l'ISSN. + %tmp = (); + $issn = ""; + @issns = grep(/^A01 /, @champs); + foreach my $item (@issns) { + ($issn) = $item =~ m|(.+?)|o; + if ( $issn =~ /^(\d\d\d\d)[^-](\d\d\d[0-9Xx])\z/o ) { + $issn = "$1-$2"; + } + elsif ( $issn =~ /^(\d\d\d\d)/(\d\d\d[0-9Xx])\z/o ) { + $issn = "$1-$2"; + } + if ( $tmp{$issn} ) { + $item = ""; + } + else { + $item = $issn; + $tmp{$issn} ++; + } + } + @issns = grep(/./, @issns); + if ( $#issns >= 0 ) { + $issn = $issns[0]; + } + + # Recherche de l'ISBN. + %tmp = (); + $isbn = ""; + @isbns = grep(/^A26 /, @champs); + foreach my $item (@isbns) { + ($isbn) = $item =~ m|(.+?)|o; + if ( $tmp{$isbn} ) { + $item = ""; + } + else { + $item = $isbn; + $tmp{$isbn} ++; + } + } + @isbns = grep(/./, @isbns); + if ( $#isbns >= 0 ) { + $isbn = $isbns[0]; + } + + # Recherche de la date de publication + if ( m|(.+?)|o ) { + my $tmp = $1; + if ( $tmp =~ /^[12]\d\d\d/ ) { + $date = substr($tmp, 0, 4); + } + else { + $date = undef; + } + } + + # Recherche du numéro de volume + $volume = ""; + if ( m|(.+?)|o ) { + $volume = $1; + $volume =~ s/^\s+//o; + $volume =~ s/\s+\z//o; + $volume =~ s|/|/|go; + if ( $volume =~ m|^(\d+)[-/](\d+)\z|o ) { + my $nb1 = $1; + my $nb2 = $2; + if ( $nb1 > $nb2 and length($nb1) > length($nb2) ) { + my $diff = length($nb1) - length($nb2); + $nb2 = substr($nb1, 0, $diff) . $nb2; + $volume = "$nb1-$nb2"; + } + } + } + + # Recherche du numéro de fascicule + $fascicule = ""; + if ( m|(.+?).*|o ) { + $fascicule = $1; + $fascicule =~ s/^\s+//o; + $fascicule =~ s/\s+\z//o; + $fascicule =~ s/&(horbar|mdash|minus);/-/go; + $fascicule =~ s/ *, */-/go; + $fascicule =~ s/-\s*\z//o; + $fascicule =~ s|/|/|go; + } + + # Recherche des numéros de page + @pages = (); + ($pagedebut, $pagefin) = ("", ""); + if ( m|(.+?)|o ) { + my $champ = $1; + my $pages = ""; + if ( $champ =~ m|(.+?)|o ) { + $pages = $1; + } + elsif ( $champ =~ m|(.+?)|o ) { + $pages = $1; + } + if ( $pages !~ /^\s*\z/o ) { + $pages =~ s/•/./go; + $pages =~ s/&(horbar|mdash|minus);/-/go; + $pages =~ s/ / /go; + $pages =~ s/^ +//o; + $pages =~ s|/|/|go; + if ( $pages =~ /^(&\w+gr; )?vol\. *\S+?, */io or + $pages =~ /^(&\w+gr; )?vol \S+?, */io or + $pages =~ /^(&\w+gr; )?vol\d+, */io or + $pages =~ /^&\w+gr;,? */o ) { + $pages = $'; + } + if ( $pages =~ / *[.+?(].*)?.*\z/io or + $pages =~ / +\d+ p\.].*/io ) { + $pages = $`; + } + if ( $pages =~ / *\(.+?\).*\z/io ) { + $pages = $`; + } + if ( $pages =~ /^([0ivx][ivx]*(-[ivx]+)?,? *([ivx]+(-[ivx]+)?,? *)*) (.+)\z/io ) { + $pages = $5; + } + if ( $pages =~ /^ *(.+?)(, *[ivx]+(-[ivx]+)?((, *| +)[ivx]+(-[ivx]+)?)*,? *)\z/io ) { + my $tmp = $1; + if ( $pages !~ /^ *[ivx]+(-[ivx]+)?((, *| +)[ivx]+(-[ivx]+)?)*,? *\z/io ) { + $pages = $tmp; + } + } + if ( $pages =~ /^s\.p\.\s*\z/io ) { + $pagedebut = undef; + } + elsif ( $pages =~ /^(\d+)-(\d+) +p\./io ) { + $pagedebut = $1; + $pagefin = $2; + } + elsif ( $pages =~ /^\S+ +p\./io ) { + $pagedebut = undef; + } + elsif ( $pages =~ /^p\. *(\S+)\z/io ) { + $pagedebut = $1; + } + elsif ( $pages =~ /^(\S+-\S+)-(\S+-\S+)\z/o ) { + $pagedebut = $1; + $pagefin = $2; + } + elsif ( $pages =~ /^(\S+?)(-\S+)?,( *(\S+-)?(\S+),)* *(\S+-)?(\S+) *\z/o ) { + $pages[0] = { 'debut' => $1, 'fin' => $7 }; + my @items = split(/, */, $pages); + while(my $item = shift @items) { + if ( $item =~ /^(\S+?)-(\S+) *\z/o ) { + push(@pages, {'debut' => $1, 'fin' => $2,}); + } + else { + if ( @items ) { + push(@pages, {'debut' => $item, 'fin' => "",}); + } + else { + push(@pages, {'debut' => "", 'fin' => $item}); + } + } + } + } + elsif ( $pages =~ /^(\S+?)-(\S+) *\z/o ) { + $pagedebut = $1; + $pagefin = $2; + } + elsif ( $pages =~ /^(\S+) *\z/o ) { + $pagedebut = $1; + } + } + } + + # Recherche du premier auteur + $nom1 = ""; + $prenom1 = ""; + my @auteurs = (); + if ( $nivbib eq "A" ) { + @auteurs = grep(!//, grep(/^A11 /, @champs)); + if ( $#auteurs < 0 ) { + @auteurs = grep(/^A11 /, @champs); + } + } + elsif ( $nivbib eq "M" ) { + @auteurs = grep(!//, grep(/^A12 /, @champs)); + if ( $#auteurs < 0 ) { + @auteurs = grep(/^A12 /, @champs); + } + } + elsif ( $nivbib eq "C" ) { + @auteurs = grep(!//, grep(/^A13 /, @champs)); + if ( $#auteurs < 0 ) { + @auteurs = grep(/^A13 /, @champs); + } + } + if ( $auteurs[0] ) { + my ($auteur) = $auteurs[0] =~ m|(.+?)|o; + if ( $auteur =~ /^(.+?) *\((.+?)\) *\z/ ) { + $nom1 = $1; + $prenom1 = $2; + } + else { + $nom1 = $auteur; + } + shift @auteurs; + } + + # Autres auteurs + @autres = (); + foreach my $suivant (@auteurs) { + my ($auteur) = $suivant =~ m|(.+?)|o; + if ( $auteur =~ /^(.+?) *\((.+?)\) *\z/ ) { + push(@autres, "$1, $2"); + } + else { + push(@autres, $auteur); + } + } + my $autres = join("|", @autres); + + # Recherche ISTEX + # Cas n° 1 : article de revue + if ( $nivbib eq "A" and ( $journal or $issn ) ) { + if ( @pages ) { + my $max = 0.0; + my %alt = (); + $label = "\nURI"; + foreach my $item (@pages) { + $pagedebut = $item->{'debut'}; + $pagefin = $item->{'fin'}; + my ($score, $id, $ark, $doi, $pii, $pmid, @pb) = traite(); + $label = "ETC"; + alerte(); + if ( $id ) { + $score *= 5.0; + my $nb = int($score); + my $note = "*" x $nb; + if ( $score - $nb > 0.5 ) { + $note .= "+"; + } + $note = "." if not $note; + $note .= "\x{A0}" x (5 - length($note)); + $score = sprintf("%.3f", $score); + if ( $score < 3.490 and $rdvfp{$id} ) { + $score .= $rdvfp{$id}; + } + if ( $score > $max or + ( $score =~ /^\d\.\d+\!\z/o and not + $max =~ /^\d\.\d+\!\z/o ) ) { + $max = $score; + } + if ( $alt{$id} ) { + if ( $alt{$id}{'score'} < $score or + ( $score =~ /^\d\.\d+\!\z/o and not + $alt{$id}{'score'} =~ /^\d\.\d+\!\z/o ) ) { + $alt{$id}{'score'} = $score; + $alt{$id}{'note'} = $note; + $alt{$id}{'debut'} = $pagedebut; + $alt{$id}{'fin'} = $pagefin; + $alt{$id}{'ark'} = $ark; + $alt{$id}{'doi'} = $doi; + $alt{$id}{'pii'} = $pii; + $alt{$id}{'pmid'} = $pmid; + } + } + else { + $alt{$id}{'score'} = $score; + $alt{$id}{'note'} = $note; + $alt{$id}{'debut'} = $pagedebut; + $alt{$id}{'fin'} = $pagefin; + $alt{$id}{'ark'} = $ark; + $alt{$id}{'doi'} = $doi; + $alt{$id}{'pii'} = $pii; + $alt{$id}{'pmid'} = $pmid; + } + } + else { + $alt{-1}{'score'} = 0.000; + $alt{-1}{'note'} = 0.000; + $alt{-1}{'debut'} = $pages[0]->{'debut'}; + $alt{-1}{'fin'} = $pages[0]->{'fin'}; + if ( $pb[0] == -1 ) { + $alt{-1}{'blanc'} = "\n"; + } + else { + $alt{-1}{'blanc'} = ""; + } + $alt{-1}{'ark'} = undef; + $alt{-1}{'doi'} = undef; + $alt{-1}{'pii'} = undef; + $alt{-1}{'pmid'} = undef; + } + } + foreach my $id (keys %alt) { + if ( $id eq "-1" and $max == 0.0 ) { + print "$alt{-1}{'blanc'}"; + print "0\t0.000\t$nivbib\t$num\t$titre\t$journal\t$livre\t$issn\t$isbn\t$date"; + print "\t$volume\t$fascicule\t$pagedebut\t$pagefin\t$nom1\t$prenom1\t$autres\t\t\t\t\t\n"; + delete $alt{-1}; + last; + } + elsif ( $alt{$id}{'score'} eq $max ) { + print "$alt{$id}{'note'}\t$alt{$id}{'score'}\t$nivbib\t$num\t$titre\t$journal"; + print "\t$livre\t$issn\t$isbn\t$date\t$volume\t$fascicule\t$pages[0]->{'debut'}"; + print "\t$pages[0]->{'fin'}\t$nom1\t$prenom1\t$autres\t$id\t$alt{$id}{'ark'}"; + print "\t$alt{$id}{'doi'}\t$alt{$id}{'pii'}\t$alt{$id}{'pmid'}\n"; + delete $alt{$id}; + last; + } + } + foreach my $id (keys %alt) { + if ( $alt{$id}{'score'} > 3.490 or $alt{$id}{'score'} =~ /^\d\.\d+\!\z/o ) { + print " --> \t$alt{$id}{'debut'}\t$alt{$id}{'fin'}\t$alt{$id}{'score'}\t$id"; + print "\t$alt{$id}{'ark'}\t$alt{$id}{'doi'}\t$alt{$id}{'pii'}\t$alt{$id}{'pmid'}\n"; + } + } + } + else { + $label = "\nURI"; + my ($score, $id, $ark, $doi, $pii, $pmid, @pb) = traite(); + alerte(); + if ( $id ) { + $score *= 5.0; + my $nb = int($score); + my $note = "*" x $nb; + if ( $score - $nb > 0.5 ) { + $note .= "+"; + } + $note = "." if not $note; + $note .= "\x{A0}" x (5 - length($note)); + $score = sprintf("%.3f", $score); + if ( $score < 3.490 and $rdvfp{$id} ) { + $score .= $rdvfp{$id}; + } + print "$note\t$score\t$nivbib\t$num\t$titre\t$journal\t$livre\t$issn\t$isbn\t$date"; + print "\t$volume\t$fascicule\t$pagedebut\t$pagefin\t$nom1\t$prenom1\t$autres\t$id"; + print "\t$ark\t$doi\t$pii\t$pmid\n"; + if ( @pb ) { + foreach my $pb (sort {$a <=> $b} @pb) { + print " ~~> \t$pb\n"; + } + } + } + else { + print "\n" if $pb[0] == -1; + print "0\t0.000\t$nivbib\t$num\t$titre\t$journal\t$livre\t$issn\t$isbn\t$date"; + print "\t$volume\t$fascicule\t$pagedebut\t$pagefin\t$nom1\t$prenom1\t$autres\t\t\t\t\t\n"; + } + } + } + else { + print "\n_\t-\t$nivbib\t$num\t$titre\t$journal\t$livre\t$issn\t$isbn\t$date"; + print "\t$volume\t$fascicule\t$pagedebut\t$pagefin\t$nom1\t$prenom1\t$autres\t\t\t\t\t\n"; + } + } + +if ( $verbeux ) { + my $moment = date(); + print STDERR " -> $moment : fin = $notice notices\n"; + } + + +exit 0; + + +sub usage +{ +print STDERR "\n$usage\n"; + +exit shift; +} + +sub date +{ +my @time = localtime(); + +my $jour = (qw(Dimanche Lundi Mardi Mercredi Jeudi Vendredi Samedi))[$time[6]]; +my $mois = (qw(Janvier Février Mars Avril Mai juin Juillet Août Septembre Octobre Novembre Décembre))[$time[4]]; +my $annee = $time[5] + 1900; + +my $moment = "$jour $time[3] $mois $annee "; +$moment .= sprintf("%02d:%02d:%02D", $time[2], $time[1], $time[0]); + +return $moment; +} + +sub alerte +{ +my $message = shift; + +if ( not $message ) { + print @alertes; + @alertes = (); + %alerte = (); + } +elsif ( not $alerte{$message} ) { + push(@alertes, "\t => $message !\n"); + $alerte{$message} ++; + } +} + +sub max +{ +my ($num1, $num2) = @_; + +if ( $num1 > $num2 ) { + return $num1; + } + +return $num2; +} + +sub get_hits +{ +my $query = shift; +$query =~ s/ /+/go; + +my $uri = "$url$query&$out&size=$size"; +$uri .= "&sid=tdm-alignement-pf"; + +my ($code, $json) = mon_get("$uri"); + +my $perl = undef; +my $suivant = undef; +my $total = undef; +my @hits = (); + +if ( defined $json ) { + eval { + $perl = decode_json $json; + }; + if ( $@ ) { + alerte("ERREUR CONVERSION JSON -> PERL"); + return(undef); + } + my %top = %{$perl}; + if ( $top{'_error'} ) { + alerte("ERREUR \"$top{'_error'}\""); + return(undef); + } + $total = $top{'total'}; + if ( $total > 0 ) { + if ( $total > 10000 ) { + alerte("RÉPONSE SUPÉRIEURE À 10 000"); + } + if ( defined $top{'nextPageURI'} ) { + $suivant = $top{'nextPageURI'}; + } + push(@hits, @{$top{'hits'}}); + + while($suivant) { + ($code, $json) = mon_get("$suivant"); + eval { + $perl = decode_json $json; + }; + if ( $@ ) { + alerte("ERREUR CONVERSION JSON -> PERL"); + return(undef); + } + %top = %{$perl}; + if ( defined $top{'nextPageURI'} ) { + $suivant = $top{'nextPageURI'}; + } + else { + $suivant = undef; + } + push(@hits, @{$top{'hits'}}); + } + } + + %top = ("total" => $total, "hits" => \@hits); + return \%top; + } +else { + return undef; + } +} + +sub get_total +{ +my $query = shift; +$query =~ s/ /+/go; + +my $uri = "$url$query&$out&size=0"; +$uri .= "&sid=tdm-alignement-pf"; + +my ($code, $json) = mon_get("$uri"); + +my $perl = undef; +my $total = undef; + +if ( defined $json ) { + eval { + $perl = decode_json $json; + }; + if ( $@ ) { + alerte("ERREUR CONVERSION JSON -> PERL"); + if ( $json =~ /\"total\": (d+),/o ) { + return($1); + } + else { + return(undef); + } + } + my %top = %{$perl}; + if ( $top{'_error'} ) { + alerte("ERREUR \"$top{'_error'}\""); + return(undef); + } + return($top{'total'}); + } +} + +sub mon_get +{ +my $cible = shift; + +my $requete = HTTP::Request->new(GET => "$cible"); + +my $reponse = $agent->request($requete); +my $code = $reponse->code; + +# Vérification de la réponse +if ($reponse->is_success) { + + + return ($code, $reponse->decoded_content); + } +else { + my $echec = 0; + my $message = $reponse->status_line; + if ( $message =~ /\b(read timeout|Proxy Error)\b/o and $echec < 10 ) { + $echec ++; + alerte("INTERRUPTION #$echec"); + sleep 2; + return mon_get($cible); + } + else { + alerte("ERREUR $code \"$message\""); + return($code, undef); + } + } +} + +sub traite +{ +my $id = undef; +my $ark = undef; +my $doi = undef; +my $pii = undef; +my $pmid = undef; +my $score = 0; + +my $query = ""; +my $altq = 0; +my @attendus = (); +my @mac = (); +my @tmp = (); +my %ok = (); + +%alerte = (); +%pages = (); +%pb = (); +%rdvfp = (); + +foreach my $item (@journaux) { + push(@tmp, "host.title:\"".propre($item)."\""); + } +foreach my $item (@issns) { + push(@tmp, "host.issn:\"$item\""); + push(@tmp, "host.eissn:\"$item\""); + push(@tmp, "serie.issn:\"$item\""); + push(@tmp, "serie.eissn:\"$item\""); + } +if ( @tmp ) { + if ( $#tmp == 0 ) { + $query .= $tmp[0]; + } + elsif ( $#tmp > 0 ) { + $query .= "(" . join(" OR ", @tmp) . ")"; + } + if ( defined $source{$query} ) { + if ( $source{$query} == 0 ) { + return(0, undef, undef, undef, undef, undef, -1); + } + } + else { + my $tmp = undef; + while( not defined $tmp ) { + $tmp = get_total($query); + if ( defined $tmp ) { + $source{$query} = $tmp; + if ( $tmp == 0 ) { + return(0, undef, undef, undef, undef, undef, -1); + } + } + } + } + } +else { + alerte("PAS DE REVUE OU ISSN"); + return(0, undef, undef, undef, undef, undef, -1); + } + +my %query = (); +$query{'journal'} = $query; + +if ( $date ) { + $query{'date'} = "publicationDate:$date OR copyrightDate:$date"; + $query{'date'} .= " OR host.publicationDate:$date OR host.copyrightDate:$date"; + $query{'date'} .= " OR serie.publicationDate:$date OR serie.copyrightDate:$date"; + } +if ( $volume ) { + if ( $volume =~ /^\d+\z/o ) { + $query{'volume'} = "host.volume:$volume"; + } + elsif ( $volume =~ m|^(\d+)[-/](\d+)\z|o ) { + my $inf = $1; + my $sup = $2; + $query{'volume'} = "host.volume.raw:\"$volume\""; + if ( $inf < $sup ) { + $query{'volume'} .= " OR host.volume:(".join(" ", ($inf .. $sup)).")"; + } + } + elsif ( $volume =~ /^(\d+)[A-Za-z]+\z/o ) { + $query{'volume'} = "host.volume.raw:\"$volume\" OR host.volume:$1"; + } + elsif ( $volume =~ /^[A-Za-z]+(\d+)\z/o ) { + $query{'volume'} = "host.volume.raw:\"$volume\" OR host.volume:$1"; + } + else { + my $tmp = propre($volume); + $query{'volume'} = "host.volume.raw:\"$tmp\""; + alerte("VOLUME \"$tmp\""); + } + } +if ( $fascicule ) { + if ( $fascicule =~ /^\d+\z/o ) { + $query{'fascicule'} = "host.issue:$fascicule"; + } + elsif ( $fascicule =~ m|^(\d+)[-/,](\d+)\z|o ) { + my $inf = $1; + my $sup = $2; + $query{'fascicule'} = "host.issue.raw:\"$fascicule\""; + if ( $inf < $sup ) { + $query{'fascicule'} .= " OR host.issue:(".join(" ", ($inf .. $sup)).")"; + } + } + elsif ( $fascicule =~ /^(\d+)([A-Za-z]+)\z/o ) { + $query{'fascicule'} = "host.issue.raw:(\"$1$2\" OR \"$2$1\") OR host.issue:$1"; + } + elsif ( $fascicule =~ /^([A-Za-z]+)(\d+)\z/o ) { + $query{'fascicule'} = "host.issue.raw:(\"$1$2\" OR \"$2$1\") OR host.issue:$2"; + } + elsif ( $fascicule =~ /^\d*[A-Za-z]+\d*[A-Za-z]*\z/o or + $fascicule =~ /^[A-Za-z]+-[A-Za-z]+\z/o ) { + $query{'fascicule'} = "host.issue.raw:\"$fascicule\""; + } + else { + my $tmp = propre($fascicule); + $query{'fascicule'} = "host.issue.raw:\"$tmp\""; + alerte("FASCICULE \"$tmp\""); + } + } + +if ( $nom1 ) { + my $auteurs = ""; + my $tmp = decode_entities($nom1); + my %tmp = ($tmp => 1); + my @tmp1 = (); + my @mots = $tmp =~ /(\p{IsAlpha}+)/go; + foreach my $mot (@mots) { + next if $mot =~ /^\p{IsAlpha}\z/o; + if ( $mot =~ /[^\0-\177]/ ) { + my $umot = unidecode($mot); + push(@tmp1, "\"".propre($mot)."\""); + push(@tmp1, "\"".propre($umot)."\""); + } + else { + push(@tmp1, "\"".propre($mot)."\""); + } + } + $auteurs = join(" OR ", @tmp1); + @tmp1 = (); + foreach my $item (@autres) { + my $nom = $item; + if ( $item =~ /^(.+?), / ) { + $nom = $1; + } + push @tmp1, decode_entities($nom); + } + my @tmp2 = grep {not $tmp{$_} ++;} @tmp1; + @tmp1 = ($auteurs); + foreach my $nom (@tmp2[0 .. 4]) { + next if not $nom; + next if $nom =~ /^\p{IsAlpha}\z/o; + if ( $nom =~ /[^\0-\177]/ ) { + $tmp = unidecode($nom); + push(@tmp1, "\"".propre($nom)."\" OR \"".propre($tmp)."\""); + } + else { + push(@tmp1, "\"".propre($nom)."\""); + } + } + $auteurs = join(" OR ", grep(/\S+/, @tmp1)); + if ( $auteurs ) { + $query{'auteur'} = "author.name:($auteurs)"; + } + } + +if ( $pagedebut ) { + @tmp = (); + my %tmp = (); + $pages{'first'}{$pagedebut} ++; + if ( $pagedebut =~ /^(.+)-\z/o ) { + $pagedebut = $1; + $pages{'first'}{$pagedebut} ++; + } + if ( $pagefin ) { + $pages{'last'}{$pagefin} ++; + if ( $pagedebut =~ /^\d+\z/o ) { + if ( $pagefin =~ /^\d+\z/o ) { + push(@{$tmp{'first'}}, "[$pagedebut TO $pagefin]"); + push(@{$tmp{'last'}}, "[$pagedebut TO $pagefin]"); + } + else { + push(@{$tmp{'first'}}, $pagedebut); + push(@{$tmp{'last.raw'}}, "\"$pagefin\""); + my $tmp = $pagefin; + if ( $fascicule and $pagefin =~ /^$fascicule[-.](.+)\z/ ) { + $tmp = $1; + $pages{'last'}{$tmp} ++; + } + elsif ( $pagefin =~ /^\w+[-.](.+)\z/ ) { + $tmp = $1; + $pages{'last'}{$tmp} ++; + } + if ( $tmp =~ /^\d+\z/o ) { + push(@{$tmp{'last'}}, $tmp); + $pages{'last'}{$pagefin} ++; + } + elsif ( $tmp =~ /^(\d+)([A-Za-z]+)\z/o ) { + push(@{$tmp{'last'}}, $1); + push(@{$tmp{'last.raw'}}, "\"$tmp\""); + push(@{$tmp{'last.raw'}}, "\"$2$1\""); + $pages{'last'}{"$1"} ++; + $pages{'last'}{"$2$1"} ++; + } + elsif ( $tmp =~ /^([A-Za-z]+)(\d+)\z/o ) { + push(@{$tmp{'last'}}, $2); + push(@{$tmp{'last.raw'}}, "\"$tmp\""); + push(@{$tmp{'last.raw'}}, "\"$2$1\""); + $pages{'last'}{"$2"} ++; + $pages{'last'}{"$2$1"} ++; + } + elsif ( $tmp ne $pagefin ) { + push(@{$tmp{'last.raw'}}, "\"$tmp\""); + } + } + } + else { + my $tmp = $pagedebut; + if ( $fascicule and $pagedebut =~ /^$fascicule[-.](.+)\z/ ) { + $tmp = $1; + # push(@{$tmp{'first.raw'}}, "\"$tmp\""); + } + elsif ( $pagedebut =~ /^\w+[-.](.+)\z/ ) { + $tmp = $1; + # push(@{$tmp{'first.raw'}}, "\"$tmp\""); + } + if ( $tmp =~ /^\d+\z/o ) { + push(@{$tmp{'first'}}, $tmp); + $pages{'first'}{$tmp} ++; + } + elsif ( $tmp =~ /^(\d+)([A-Za-z]+)\z/o ) { + push(@{$tmp{'first'}}, $1); + push(@{$tmp{'first.raw'}}, "\"$tmp\""); + push(@{$tmp{'first.raw'}}, "\"$2$1\""); + $pages{'first'}{"$1"} ++; + $pages{'first'}{"$2$1"} ++; + } + elsif ( $tmp =~ /^([A-Za-z]+)(\d+)\z/o ) { + push(@{$tmp{'first'}}, $2); + push(@{$tmp{'first.raw'}}, "\"$tmp\""); + push(@{$tmp{'first.raw'}}, "\"$2$1\""); + $pages{'first'}{"$2"} ++; + $pages{'first'}{"$2$1"} ++; + } + else { + push(@{$tmp{'first.raw'}}, "\"$tmp\""); + $pages{'first'}{$tmp} ++; + } + $tmp = $pagefin; + if ( $fascicule and $pagefin =~ /^$fascicule[-.](.+)\z/ ) { + $tmp = $1; + push(@{$tmp{'last.raw'}}, "\"$tmp\""); + } + elsif ( $pagefin =~ /^\w+[-.](.+)\z/ ) { + $tmp = $1; + push(@{$tmp{'last.raw'}}, "\"$tmp\""); + } + $pages{'last'}{$tmp} ++; + if ( $tmp =~ /^\d+\z/o ) { + push(@{$tmp{'last'}}, $tmp); + } + elsif ( $tmp =~ /^(\d+)([A-Za-z]+)\z/o ) { + push(@{$tmp{'last'}}, $1); + push(@{$tmp{'last.raw'}}, "\"$tmp\""); + push(@{$tmp{'last.raw'}}, "\"$2$1\""); + $pages{'last'}{"$1"} ++; + $pages{'last'}{"$2$1"} ++; + } + elsif ( $tmp =~ /^([A-Za-z]+)(\d+)\z/o ) { + push(@{$tmp{'last'}}, $2); + push(@{$tmp{'last.raw'}}, "\"$tmp\""); + push(@{$tmp{'last.raw'}}, "\"$2$1\""); + $pages{'last'}{"$2"} ++; + $pages{'last'}{"$2$1"} ++; + } + else { + push(@{$tmp{'last.raw'}}, "\"$tmp\""); + } + } + } + else { + if ( $pagedebut =~ /^\d+\z/o ) { + push(@{$tmp{'first'}}, "\"$pagedebut\""); + } + else { + my $tmp = $pagedebut; + if ( $fascicule and $pagedebut =~ /^$fascicule[-.](.+)\z/ ) { + $tmp = $1; + push(@{$tmp{'first.raw'}}, "\"$tmp\""); + } + elsif ( $pagedebut =~ /^\w+[-.](.+)\z/ ) { + $tmp = $1; + push(@{$tmp{'first.raw'}}, "\"$tmp\""); + } + $pages{'first'}{$tmp} ++; + if ( $tmp =~ /^\d+\z/o ) { + push(@{$tmp{'first'}}, $tmp); + } + elsif ( $tmp =~ /^(\d+)([A-Za-z]+)\z/o ) { + push(@{$tmp{'first'}}, $1); + push(@{$tmp{'first.raw'}}, "\"$tmp\""); + push(@{$tmp{'first.raw'}}, "\"$2$1\""); + $pages{'first'}{"$1"} ++; + $pages{'first'}{"$2$1"} ++; + } + elsif ( $tmp =~ /^([A-Za-z]+)(\d+)\z/o ) { + push(@{$tmp{'first'}}, $2); + push(@{$tmp{'first.raw'}}, "\"$tmp\""); + push(@{$tmp{'first.raw'}}, "\"$2$1\""); + $pages{'first'}{"$2"} ++; + $pages{'first'}{"$2$1"} ++; + } + else { + push(@{$tmp{'first.raw'}}, "\"$tmp\""); + } + } + } + foreach my $tmp (sort keys %tmp) { + my @items = @{$tmp{$tmp}}; + next if $#items < 0; + if ( $#items == 0 ) { + push(@tmp, "host.pages.$tmp:$items[0]"); + } + else { + push(@tmp, "host.pages.$tmp:(".join(" OR ", @items).")"); + } + } + if ( @tmp ) { + $query{'page'} = join(" OR ", @tmp); + } + } + +if ( $titre ) { + @tmp = grep(!/^(and|not|or)\z/io, ($titre =~ /(\w+)/go)); + my @mots = sort {length($b) <=> length($a) or $a cmp $b} @tmp; + splice (@mots, 3); + $query{'titre'} = "title:(" . join(" ", @mots) . ")"; + } + +# Composition de la requête +if ( $query{'date'} or $query{'volume'} or $query{'fascicule'} ) { + $query .= " AND (".join(" OR ", grep {defined $_;} $query{'date'}, + $query{'volume'}, $query{'fascicule'}).")"; + } +$query{'base'} = $query; +if ( $query{'auteur'} or $query{'page'} ) { + $query .= " AND (".join(" OR ", grep {defined $_;} $query{'auteur'}, + $query{'page'}).")"; + } +else { + $query .= " AND " . $query{'titre'}; + $query{'base'} = undef; + } + +# Envoi de la requête +print "$label : \"$url$query&$out\"\n"; + +my $perl = get_hits($query); +if ( defined $perl ) { + %modifs = (); + my %top = %{$perl}; + printf "\t => %d\n", $top{'total'}; + if ( $top{'total'} >= 1 ) { + @attendus = (); + if ( $nom1 ) { + push @attendus, decode_entities($nom1) ; + } + foreach my $item (@autres) { + my $nom = $item; + if ( $item =~ /^(.+?), / ) { + $nom = $1; + } + push @attendus, decode_entities($nom); + } + @mac = (); + my $mac = 0; + foreach my $item (@attendus) { + if ( $item =~ /\bma?c ?(\w+)/oi ) { + my $canon = "$`Mc$1$'"; + $mac ++ if $canon ne $item; + push(@mac, $canon); + } + else { + push(@mac, $item); + } + } + if ( $mac == 0 ) { + @mac = (); + } + my @hits = @{$top{'hits'}}; + foreach my $hit (@hits) { + my ($valeur, $idCourant, $arkCourant, $refId, $ok) = evalue($hit, \@attendus, \@mac); + if ( $valeur > $score ) { + $score = $valeur; + $id = $idCourant; + $ark = $arkCourant; + $doi = defined $refId->{'doi'} ? $refId->{'doi'} : undef; + $pii = defined $refId->{'pii'} ? $refId->{'pii'} : undef; + $pmid = defined $refId->{'pmid'} ? $refId->{'pmid'} : undef; + print STDERR "\t=> score = $score\n\n" if $debug; + } + elsif ( $debug ) { + print STDERR "\n"; + } + if ( $ok =~ /D[VIFvif]+/o ) { + $ok{$ok} ++; + } + last if $score == 1.000; + } + } + } +else { + alerte("ERREUR"); + } + +if ( $score == 0 and $query{'base'} and $query{'titre'} ) { + alerte(); + $query = $query{'base'}; + $query .= " AND " . $query{'titre'}; + # Envoi de la requête + print "RAC : \"$url$query&$out\"\n"; + + my $perl = get_hits($query); + if ( defined $perl ) { + my %top = %{$perl}; + printf "\t => %d\n", $top{'total'}; + if ( $top{'total'} >= 1 ) { + my @hits = @{$top{'hits'}}; + foreach my $hit (@hits) { + my ($valeur, $idCourant, $arkCourant, $refId, $ok) = evalue($hit, \@attendus, \@mac); + if ( $valeur > $score ) { + $score = $valeur; + $id = $idCourant; + $ark = $arkCourant; + $doi = defined $refId->{'doi'} ? $refId->{'doi'} : undef; + $pii = defined $refId->{'pii'} ? $refId->{'pii'} : undef; + $pmid = defined $refId->{'pmid'} ? $refId->{'pmid'} : undef; + print STDERR "\t=> score = $score\n\n" if $debug; + } + elsif ( $debug ) { + print STDERR "\n"; + } + if ( $ok =~ /D[VIFvif]+/o ) { + $ok{$ok} ++; + } + last if $score == 1.000; + } + } + } + else { + alerte("ERREUR"); + } + } + +my @liste = groupe($pb{$id}) if not @pages; + +return ($score, $id, $ark, $doi, $pii, $pmid, @liste); +} + +sub evalue +{ +my $hit = shift; +my $ref = shift; +my @attendus = @{$ref}; +$ref = shift; +my @mac1 = @{$ref}; + +my $proche = ""; +my $score = 0; +my $succes = 0; +my $total = 0; + +my %hit = %{$hit}; +my $id = $hit{'id'}; +my $ark = $hit{'arkIstex'}; +my %id = (); + +$id{'doi'} = defined $hit{'doi'} ? $hit{'doi'}->[0] : 'N/A'; +$id{'pii'} = defined $hit{'pii'} ? $hit{'pii'}->[0] : undef; +$id{'pmid'} = defined $hit{'pmid'} ? $hit{'pmid'}->[0] : undef; + +my %host = (); +if ( $hit{'host'} ) { + %host = %{$hit{'host'}}; + } +my %serie = (); +if ( $hit{'serie'} ) { + %serie = %{$hit{'serie'}}; + } +# Test de l'ISSN +my %bib = (); +my @nums = (); +if ( $host{'issn'} ) { + @nums = @{$host{'issn'}}; + } +if ( @nums and @issns ) { + $total ++; + my $trouve = 0; + foreach my $issn1 (@nums) { + foreach my $issn2 (@issns) { + if ( $issn1 eq $issn2 or + uc($issn1) eq uc($issn2) ) { + $trouve = $issn1; + } + } + } + if ( $trouve ) { + $succes ++ ; + $bib{'issn'} = $trouve; + print STDERR "ISSN : +1\n" if $debug; + } + elsif ( $debug ) { + print STDERR "ISSN : 0\n" if $debug; + } + } +elsif ( $debug ) { + print STDERR "ISSN : N.A.\n" if $debug; + } +my $revue = $host{'title'}; +my $serie = defined $serie{'title'} ? $serie{'title'} : undef; +# Test du nom de la revue +if ( @journaux and ( $revue or $serie ) ) { + $total ++; + my $trouve = 0; + if ( $revue ) { + $trouve = revue($revue, @journaux); + if ( $trouve ) { + $succes ++ ; + $bib{'revue'} ++; + } + } + if ( $serie and not $trouve ) { + $trouve = revue($serie, @journaux); + if ( $trouve ) { + $succes ++ ; + $bib{'serie'} ++; + } + } + if ( $trouve ) { + print STDERR "Revue : +1\n" if $debug; + } + else { + print STDERR "Revue : 0\n" if $debug; + } + } +elsif ( $debug ) { + print STDERR "Revue : N.A.\n" if $debug; + } +# Récupération de la date +$bib{'publicationDate'} = $hit{'publicationDate'} ? $hit{'publicationDate'} : undef; +$bib{'copyrightDate'} = $hit{'copyrightDate'} ? $hit{'copyrightDate'} : undef; +$bib{'host.publicationDate'} = $host{'publicationDate'} ? $host{'publicationDate'} : undef; +$bib{'host.copyrightDate'} = $host{'copyrightDate'} ? $host{'copyrightDate'} : undef; +$bib{'serie.publicationDate'} = $serie{'publicationDate'} ? $serie{'publicationDate'} : undef; +$bib{'serie.copyrightDate'} = $serie{'copyrightDate'} ? $serie{'copyrightDate'} : undef; +if ( defined $bib{'publicationDate'} and + $bib{'publicationDate'} eq $date ) { + $bib{'date'} ++; + } +if ( defined $bib{'copyrightDate'} and + $bib{'copyrightDate'} eq $date ) { + $bib{'date'} ++; + } +if ( defined $bib{'host.publicationDate'} and + $bib{'host.publicationDate'} eq $date ) { + $bib{'date'} ++; + } +if ( defined $bib{'host.copyrightDate'} and + $bib{'host.copyrightDate'} eq $date ) { + $bib{'date'} ++; + } +if ( defined $bib{'serie.publicationDate'} and + $bib{'serie.publicationDate'} eq $date ) { + $bib{'date'} ++; + } +if ( defined $bib{'serie.copyrightDate'} and + $bib{'serie.copyrightDate'} eq $date ) { + $bib{'date'} ++; + } +if ( $bib{'date'} ) { + $proche .= "D"; + } +# Test du volume +my $vol = $host{'volume'}; +my $masque = ""; +if ( $vol and $volume ) { + $total ++; + $proche .= "v"; + if ( $vol eq $volume or biniou($vol, $volume, "VOLUME") ) { + $succes ++; + $bib{'volume'} ++; + $proche =~ s/v/V/o; + print "Volume : +1\n" if $debug; + } + elsif ( unidecode($vol) eq unidecode($volume) ) { + $succes ++; + $bib{'volume'} ++; + $proche =~ s/v/V/o; + print "Volume : +1\n" if $debug; + } + elsif ( $debug ) { + print "Volume : 0\n" if $debug; + } + } +elsif ( $vol and $fascicule ) { + $total ++; + $proche .= "i"; + if ( $vol eq $fascicule or biniou($vol, $fascicule, "VOLUME/FASCICULE") ) { + $succes ++; + $bib{'volume'} ++; + $proche =~ s/i/I/o; + $masque = $fascicule; + $fascicule = ""; + alerte("VOLUME = ISSUE"); + print "Volume : +1\n" if $debug; + } + elsif ( unidecode($vol) eq unidecode($fascicule) ) { + $succes ++; + $bib{'volume'} ++; + $proche =~ s/i/I/o; + $masque = $fascicule; + $fascicule = ""; + alerte("VOLUME = ISSUE"); + print "Volume : +1\n" if $debug; + } + elsif ( $debug ) { + print "Volume : 0\n" if $debug; + } + } +elsif ( $debug ) { + print STDERR "Volume : N.A.\n"; + } +# Test du numéro de fascicule +my $issue = $host{'issue'}; +if ( $issue and $fascicule ) { + $total ++; + $proche .= "f"; + my $trouve = 0; + if ( $issue eq $fascicule or biniou($issue, $fascicule, "FASCICULE") ) { + $trouve ++; + } + elsif ( unidecode($issue) eq unidecode($fascicule) ) { + $trouve ++; + } + if ( not $trouve ) { + if ( $fascicule =~ /^\p{IsAlpha}+(\d+)\z/ ) { + my $tmp = $1; + $trouve ++ if $issue eq $tmp; + } + elsif ( $fascicule =~ /^(\d+)\p{IsAlpha}+\z/ ) { + my $tmp = $1; + $trouve ++ if $issue eq $tmp; + } + } + if ( $trouve ) { + $succes ++; + $proche =~ s/f/F/o; + $bib{'fascicule'} ++; + print "Numéro : +1\n" if $debug; + } + elsif ( $debug ) { + print "Numéro : 0\n" if $debug; + } + } +elsif ( $debug ) { + print STDERR "Numéro : N.A.\n"; + } +if ( $masque and not $fascicule ) { + $fascicule = $masque; + $masque = ""; + } + +my $okdebut = undef; +my $okfin = undef; +my $first = $host{'pages'}{'first'}; +# Test du numéro de première page +if ( $first and $pagedebut ) { + $total ++; + my @tmp = (); + my $safe = $first; + $safe =~ s/(\W)/\\$1/go; + if ( defined $pages{'first'} ) { + @tmp = sort keys %{$pages{'first'}}; + } + if ( $first eq $pagedebut ) { + $succes ++; + $bib{'pagedebut'} ++; + $okdebut = $pagedebut; + print STDERR "Page début : +1\n" if $debug; + } + elsif ( grep(/^$safe\z/, @tmp) > 0 ) { + $succes ++; + $bib{'pagedebut'} ++; + $okdebut = (grep(/^$first\z/, @tmp))[0]; + print STDERR "Page début : +1\n" if $debug; + } + elsif ( $debug ) { + print STDERR "Page début : 0\n"; + } + } +elsif ( $debug ) { + print STDERR "Page début : N.A.\n"; + } +my $last = $host{'pages'}{'last'}; +# Test du numéro de dernière page +if ( $last and $pagefin ) { + $total ++; + my @tmp = (); + my $safe = $last; + $safe =~ s/(\W)/\\$1/go; + if ( defined $pages{'last'} ) { + @tmp = sort keys %{$pages{'last'}}; + } + if ( $last eq $pagefin ) { + $succes ++; + $bib{'pagefin'} ++; + $okfin = $pagefin; + print STDERR "Page fin : +1\n" if $debug; + } + elsif ( grep(/^$safe\z/, @tmp) > 0 ) { + $succes ++; + $bib{'pagefin'} ++; + $okfin = (grep(/^$last\z/, @tmp))[0]; + print STDERR "Page fin : +1\n" if $debug; + } + elsif ( $debug ) { + print STDERR "Page fin : 0\n"; + } + } +elsif ( $debug ) { + print STDERR "Page fin : N.A.\n"; + } + +# Indication que les données bibliographiques +# sont a priori correctes +if ( ( $bib{'revue'} or $bib{'issn'} ) and + ( $bib{'volume'} or $bib{'fascicule'} ) and + $bib{'date'} and $okdebut and $okfin ) { + $rdvfp{$id} = "!"; + } + +# Test du pb des notices Pascal (et Francis ?) +# groupant plusieurs articles +$pb{$id} = undef; +if ( $first and $pagedebut and $last and $pagefin ) { + if ( ( $first > $pagedebut and $first <= $pagefin ) or + ( $last < $pagefin and $last >= $pagedebut ) ) { + my %tmp = (); + if ( ( $bib{'revue'} or $bib{'issn'} ) and + ( $bib{'volume'} or $bib{'fascicule'} or + $bib{'publicationDate'} or $bib{'copyrightDate'} or + $bib{'host.publicationDate'} or $bib{'host.copyrightDate'} or + $bib{'serie.publicationDate'} or $bib{'serie.copyrightDate'} ) ) { + $tmp{'revue'} = $revue if $revue; + $tmp{'serie'} = $serie if $serie; + $tmp{'issn'} = $bib{'issn'} if $bib{'issn'}; + $tmp{'volume'} = $vol if $vol; + $tmp{'fascicule'} = $issue if $issue; + $tmp{'publicationDate'} = $bib{'publicationDate'}; + $tmp{'copyrightDate'} = $bib{'copyrightDate'}; + $tmp{'host.publicationDate'} = $bib{'host.publicationDate'}; + $tmp{'host.copyrightDate'} = $bib{'host.copyrightDate'}; + $tmp{'serie.publicationDate'} = $bib{'serie.publicationDate'}; + $tmp{'serie.copyrightDate'} = $bib{'serie.copyrightDate'}; + $tmp{'pagedebut'} = $pagedebut; + $tmp{'pagefin'} = $pagefin; + $pb{$id} = \%tmp; + } + } + } +# Le test devrait être plus circonstancié !!! +# Seulement si on a assez d'éléments pour être sûr !!! +my $bib = 0; +if ( $total >= 4 and $total == $succes ) { + if ( ($bib{'revue'} or $bib{'issn'}) and + ($bib{'volume'} or $bib{'fascicule'}) and + ($bib{'pagedebut'} or $bib{'pagefin'}) ) { + $bib = 1; + } + } +my $poids = 2; +# Commenté pour l'instant en attendant de voir +# si c'est aussi futé que je le croyais ! +# if ( $total <= 4 ) { +# $poids = 1; +# } +# if ( not $bib ) { +# $total = max(4, $total + 1); +# } +if ( $debug ) { + print STDERR "\n\t=> total = $total\n"; + print STDERR "\t=> bib = $bib\n"; + print STDERR "\t=> poids = $poids\n\n"; + } +# Test du titre +my $title = $hit{'title'}; +if ( $title and $titre ) { + $total ++; + my $trouve = 0; + my $pot = 0; + if ( $titre =~ /^Pro and con\s*:\s*/o and + $title =~ /^(Pro|Con)\s*:/o ) { + my ($tmp1) = $titre =~ /^Pro and con\s*:\s*(\S.+)/o; + my ($tmp2) = $title =~ /^(?:Pro|Con)\s*:\s*(\S.+)/o; + if ( $pot = titre($tmp2, $tmp1, $bib) ) { + $trouve ++; + } + } + elsif ( $pot = titre($title, $titre, $bib) ) { + $trouve ++; + } + if ( not $trouve and $titre =~ / [IVXLCDM]+ *:/o ) { + if ( $pot = romain($title, $titre) ) { + $trouve ++; + } + } + if ( $trouve ) { + $succes += $pot; + print STDERR "Titre : +$pot\n" if $debug; + } + elsif ( $debug ) { + print STDERR "Titre : 0\n"; + } + } +elsif ( $debug ) { + print STDERR "Titre : N.A.\n"; + } +# +my @auteurs = (); +if ( $hit{'author'} ) { + @auteurs = @{$hit{'author'}}; + } +# Test des noms d'auteur +my @mac2 = (); +my $mac2 = 0; +if ( ( @auteurs and not @attendus ) or + ( @attendus and not @auteurs ) ) { + $total += 1; + } +elsif ( @auteurs and @attendus ) { + my $ld = 0; + my $trouve = 0; + my @names = (); + foreach my $auteur (@auteurs) { + my %auteur = %{$auteur}; + next unless $auteur{'name'}; # Est-ce possible et si oui, que fait-on ? + my $name = $auteur{'name'}; + if ( $name =~ /\bma?c ?(\w+)/oi ) { + my $canon = "$`Mc$1$'"; + $mac2 ++ if $canon ne $name; + push(@mac2, $canon); + } + else { + push(@mac2, $name); + } + push(@names, $name); + } + if ( $mac2 == 0 ) { + @mac2 = (); + } + ($trouve, $ld) = ld_au(\@attendus, \@names); + if ( $ld and (@mac1 or @mac2) ) { + my $trouve2 = undef; + my $ld2 = undef; + if ( @mac1 and @mac2 ) { + ($trouve2, $ld2) = ld_au(\@mac1, \@mac2); + } + elsif ( @mac1 ) { + ($trouve2, $ld2) = ld_au(\@mac1, \@names); + } + else { + ($trouve2, $ld2) = ld_au(\@attendus, \@mac2); + } + if ( $trouve2 >= $trouve and $ld2 <= $ld ) { + $trouve = $trouve2; + $ld = $ld2; + alerte("CORRECTION MAC"); + } + } + if ( $trouve == ($#attendus + 1) and $ld and $bib ) { + alerte("RATTRAPAGE"); + $ld = 0; + } + my $ild = 1 - ($ld / ($#auteurs + $#attendus + 2)); + $total += $poids; + if ( $#auteurs == $#attendus ) { + $poids = $poids * $trouve * $ild / ($#auteurs + 1); +# $succes += $poids * $trouve * $ild / ($#auteurs + 1); + $succes += $poids; + } + elsif ( $#auteurs > $#attendus ) { + if ( $#attendus > 34 and $#auteurs > 59 and $#auteurs - $#attendus > 2 ) { + $poids = $poids * $trouve * $ild / ($#attendus + 1); + } + else { + $poids = $poids * $trouve * $ild / ($#auteurs + 1); + } + $succes += $poids; + } + else { + $poids = $poids * $trouve * $ild / ($#attendus + 1); + $succes += $poids; + } + print STDERR "Auteurs : +$poids\n\n" if $debug; + } +elsif ( $debug ) { + print STDERR "Auteurs : N.A.\n\n"; + } +print STDERR "\t=> total = $total\n" if $debug; +if ( $total ) { + $score = $succes/$total; + print STDERR "\t=> succes = $succes\n" if $debug; + print STDERR "\t=> score = $score\n\n" if $debug; + return($score, $id, $ark, \%id, $proche); + } +else { + alerte("TOTAL NUL"); + return(0, $id, $ark, \%id, $proche); + } +} + +sub propre +{ +my $chaine = shift; +my $tmp1 = ""; +my $tmp2 = ""; + +# Conversion vers UTF-8 et échappement des caractères réservés +$tmp1 = decode_entities($chaine); +$tmp1 =~ s#([+&|!(){}^"~*?:\/])#\\$1#go; +$tmp1 =~ s#([][])#\\$1#go; + +# URLencodage +$tmp2 = uri_encode($tmp1); +$tmp2 =~ s/%20/ /go; +$tmp2 =~ s/&/%26/go; + +return $tmp2; +} + +sub titre +{ +my ($t1, $t2, $sb) = @_; + +if ( $t1 eq $t2 or + lc($t1) eq lc($t2) or + lc(unidecode($t1)) eq lc(unidecode($t2))) { + return 1; + } + +$t2 =~ s|||go; + +my $tmp1 = lc(join(" ", ($t1 =~ /(\w+)/go))); +my $tmp2 = lc(join(" ", ($t2 =~ /(\w+)/go))); + +if ( $tmp1 eq $tmp2 ) { + return 1; + } +elsif ( unidecode($tmp1) eq unidecode($tmp2) ) { + return 1; + } +else { + $tmp1 = unidecode($tmp1); + $tmp2 = unidecode($tmp2); + my $ld = levenshtein_damereau($tmp1, $tmp2); + if ( $ld == 1 and length($tmp2) > 20 ) { + return 1; + } + elsif ( $ld == 2 and length($tmp2) > 40 ) { + return 1; + } + } + +if ( $sb ) { + if ( $tmp1 =~ /\b$tmp2\b/ or $tmp2 =~ /\b$tmp1\b/ ) { + return 0.5; + } + } + +if ( $t1 =~ /: /o or $t2 =~ /: /o ) { + my ($tmp1) = $t1 =~ /^(.+?)\s*: /o; + my ($tmp2) = $t2 =~ /^(.+?)\s*: /o; + if ( $tmp1 eq $tmp2 ) { + alerte("TITRE RÉDUIT 1"); + return 1; + } + else { + $tmp1 = lc(join(" ", ($tmp1 =~ /(\w+)/go))); + $tmp2 = lc(join(" ", ($tmp2 =~ /(\w+)/go))); + if ( $tmp1 eq $tmp2 ) { + alerte("TITRE RÉDUIT 2"); + return 1; + } + elsif ( unidecode($tmp1) eq unidecode($tmp2) ) { + alerte("TITRE RÉDUIT 3"); + return 1; + } + } + } + +## Test partie de titre +($tmp1 = $t1) =~ s/([^\w ])/\\$1/go; +($tmp2 = $t2) =~ s/([^\w ])/\\$1/go; +if ( length($t1) > length($t2) ) { + if ( $tmp1 =~ /^$tmp2\. .+/i ) { + alerte("TITRE RÉDUIT 4"); + return 0.5; + } + } +elsif ( length($t1) < length($t2) ) { + if ( $tmp2 =~ /^$tmp1\. .+/i ) { + alerte("TITRE RÉDUIT 4"); + return 0.5; + } + } + +return 0; +} + +sub ld_au # Levenshtein-Damereau adapté aux listes d'auteurs +{ +my ($ref1, $ref2) = @_; + +my @liste1 = @{$ref1}; +my @liste2 = @{$ref2}; + +my $len1 = $#liste1 + 1; +my $len2 = $#liste2 + 1; + +return $len2 if $len1 == 0; +return $len1 if $len2 == 0; + +my %mat = (); + +for ( my $i = 0 ; $i <= $len1 ; $i ++ ) { + for ( my $j = 0 ; $j <= $len2 ; $j ++ ) { + $mat{$i}{$j} = 0; + $mat{0}{$j} = $j; + } + $mat{$i}{0} = $i; + } + +my $cost = 0; +my %trouve = (); + +for ( my $i = 1 ; $i <= $len1 ; $i ++ ) { + my $trouve = 0; + for ( my $j = 1 ; $j <= $len2 ; $j ++ ) { + $cost = 1 - compare($liste1[$i-1], $liste2[$j-1]); + $trouve ++ if $cost == 0; + $mat{$i}{$j} = min ([$mat{$i-1}{$j} + 1, + $mat{$i}{$j-1} + 1, + $mat{$i-1}{$j-1} + $cost]); + if ( $i > 1 and $j > 1 and + compare($liste1[$i - 1], $liste2[$j - 2]) and + compare($liste1[$i - 2], $liste2[$j - 1]) ) { + $mat{$i}{$j} = min ([$mat{$i}{$j}, + $mat{$i-2}{$j-2} + $cost]); + } + } + $trouve{$liste1[$i-1]} ++ if $trouve; + } + +my $trouve = 0; +foreach my $item (keys %trouve) { + $trouve += $trouve{$item}; + } + +# print "\t -> $trouve ; $mat{$len1}{$len2}\n"; +if ( $len1 > 35 and $len2 > 60 and $len2 - $len1 > 2 ) { + return ($trouve, $mat{$len1}{$len1}); + } +else { + return ($trouve, $mat{$len1}{$len2}); + } +} + +sub levenshtein_damereau +{ +my ($s1, $s2) = @_; + +my $len1 = length $s1; +my $len2 = length $s2; + +return $len2 if $len1 == 0; +return $len1 if $len2 == 0; + +my %mat = (); + +for ( my $i = 0 ; $i <= $len1 ; $i ++ ) { + for ( my $j = 0 ; $j <= $len2 ; $j ++ ) { + $mat{$i}{$j} = 0; + $mat{0}{$j} = $j; + } + $mat{$i}{0} = $i; + } + +my @ar1 = split(//, $s1); +my @ar2 = split(//, $s2); + +my $cost = 0; + +for ( my $i = 1 ; $i <= $len1 ; $i ++ ) { + for ( my $j = 1 ; $j <= $len2 ; $j ++ ) { + $cost = $ar1[$i-1] eq $ar2[$j-1] ? 0 : 1; + $mat{$i}{$j} = min ([$mat{$i-1}{$j} + 1, + $mat{$i}{$j-1} + 1, + $mat{$i-1}{$j-1} + $cost]); + if ( $i > 1 and $j > 1 and + $ar1[$i - 1] eq $ar2[$j - 2] and + $ar1[$i - 2] eq $ar2[$j - 1] ) { + $mat{$i}{$j} = min ([$mat{$i}{$j}, $mat{$i-2}{$j-2} + $cost]); + } + } + } + +return $mat{$len1}{$len2}; +} + +sub min +{ +my @liste = @{$_[0]}; +my $min = shift @liste; + +foreach my $i (@liste) { + $min = $i if $i < $min; + } + +return $min; +} + +sub romain +{ +my ($t2, $t1) = @_; + +my $p2 = join(" ", ($t2 =~ /(\p{IsAlnum}+)/go)); + +while( $t1 =~ / ([IVXLCDM]+) *: */go ) { + my $avant = $`; + my $apres = $'; + my $numR = $1; + (my $tav = $avant) =~ s/([^\p{IsAlnum} ])/\\$1/go; + (my $tap = $apres) =~ s/([^\p{IsAlnum} ])/\\$1/go; + my $val = $convert->arabic($numR); + if ( $t2 =~ /^$tav +(\p{IsAlnum}+ )?($val|$numR) *[:.] *$tap\z/i ) { + return 1; + } + else { + my $pav = join(" ", ($avant =~ /(\p{IsAlnum}+)/go)); + my $pap = join(" ", ($apres =~ /(\p{IsAlnum}+)/go)); + if ( $p2 =~ /^$pav +(\p{IsAlnum}+ )?($val|$numR) *$pap\z/i ) { + return 1; + } + elsif ( $p2 =~ /^$pav +(\p{IsAlnum}+ )?\p{IsAlnum}+ *$pap\z/i ) { + return 0.5; + } + } + } + +return 0; +} + +sub compare +{ +my ($attendu, $name) = @_; + +(my $safe = $attendu) =~ s/([^\p{IsAlnum} ])/\\$1/go; + +if ( $name =~ /\b$safe\b/i ) { +# print "\t - $attendu <=> $name : 1\n"; + return 1; + } + +$name =~ s/[\x{60}\x{B4}\x{B8}]//go; + +my $tmp1 = lc(unidecode($name)); +my $tmp2 = lc(unidecode($attendu)); +($safe = $tmp2) =~ s/([^\p{IsAlnum} ])/\\$1/go; +if ( $tmp1 =~ /\b$safe\b/ ) { +# print "\t - $attendu <=> $name : 1\n"; + return 1; + } + +my @tmp1 = split(/\s+/o, $tmp1); +my $premier = shift @tmp1; +$tmp1 = join(" ", @tmp1, $premier); +if ( $tmp1 =~ /\b$safe\b/ ) { + return 1; + } +unshift @tmp1, $premier; +my $dernier = pop @tmp1; +$tmp1 = join(" ", $dernier, @tmp1); +if ( $tmp1 =~ /\b$safe\b/ ) { + return 1; + } + +# print "\t - $attendu <=> $name : 0\n"; +return 0; +} + +sub biniou +{ +my ($val1, $val2, $champ) = @_; + +if ( $val1 =~ /^\d+\z/o ) { + if ( $val2 =~ /^(\d+)[-\x{2010}-\x{2015}\x{2212}](\d+)\z/o ) { + my $inf = $1; + my $sup = $2; + if ( $inf < $sup and $val1 >= $inf and $val1 <= $sup ) { + return 1; + } + } + } +elsif ( $val1 =~ m|^(\d+)[-\x{2010}-\x{2015}\x{2212}/](\d+)\z|o ) { + my $inf = $1; + my $sup = $2; + if ( $val2 =~ /^\d+\z/o ) { + if ( $inf < $sup and $val2 >= $inf and $val2 <= $sup ) { + return 1; + } + } + elsif ( $val2 =~ m|^(\d+)[-\x{2010}-\x{2015}\x{2212}/](\d+)\z|o ) { + my $inf2 = $1; + my $sup2 = $2; + if ( $inf == $inf2 and $sup == $sup2 ) { + return 1; + } + } + } +elsif ( $val1 =~ /^([A-Za-z]+)(\d+)\z/o ) { + my $vl = $1; + my $vn = $2; + if ( $val2 =~ /^([A-Za-z])(\d+)[-\x{2010}-\x{2015}\x{2212}]([A-Za-z])(\d+)\z/o ) { + my $infl = $1; + my $infn = $2; + my $supl = $3; + my $supn = $4; + if ( $infl eq $supl ) { + if ( $vl eq $infl and $vn >= $infn and $vn <= $supl ) { + return 1; + } + } + elsif ( $infl lt $supl ) { + if ( $vl eq $infl and $vn >= $infn ) { + return 1; + } + if ( $vl eq $supl and $vn <= $supn ) { + return 1; + } + if ( $vl gt $infl and $vl lt $supl ) { + return 1 + } + } + else { + alerte("FORMAT $champ ISTEX BIZARRE \"$val2\"") + } + } + } +elsif ( $val1 =~ /^([A-Za-z])(\d+)[-\x{2010}-\x{2015}\x{2212}]([A-Za-z])(\d+)\z/o ) { + my $infl = $1; + my $infn = $2; + my $supl = $3; + my $supn = $4; + if ( $val2 =~ /^([A-Za-z]+)(\d+)\z/o ) { + my $vl = $1; + my $vn = $2; + if ( $infl eq $supl ) { + if ( $vl eq $infl and $vn >= $infn and $vn <= $supl ) { + return 1; + } + } + elsif ( $infl lt $supl ) { + if ( $vl eq $infl and $vn >= $infn ) { + return 1; + } + if ( $vl eq $supl and $vn <= $supn ) { + return 1; + } + if ( $vl gt $infl and $vl lt $supl ) { + return 1 + } + } + else { + alerte("FORMAT $champ INIST BIZARRE \"$val1\"") + } + } + } +else { + alerte("FORMAT $champ INIST INATTENDU \"$val1\""); + if ( $val2 !~ /^\d+\z/o and + $val2 !~ /^([A-Za-z]+)(\d+)\z/o and + $val2 !~ /^(\d+)[-\x{2010}-\x{2015}\x{2212}](\d+)\z/o and + $val2 !~ /^([A-Za-z])(\d+)[-\x{2010}-\x{2015}\x{2212}]([A-Za-z])(\d+)\z/o ) { + alerte("FORMAT $champ ISTEX INATTENDU \"$val2\""); + } + } + +return 0; +} + +sub groupe +{ +my $ref = shift; + +my $query = ""; +my @liste = (); + +return @liste if not defined $ref or ref($ref) ne 'HASH'; + +alerte(); + +my %hash = %{$ref}; + +if ( defined $hash{'revue'} ) { + my $revue = propre($hash{'revue'}); + $query = "host.title:\"$revue\""; + } + +if ( defined $hash{'serie'} ) { + my $revue = propre($hash{'serie'}); + if ( $revue !~ /#/o ) { + $query .= " AND " if $query; + $query = "serie.title:\"$revue\""; + } + } + +if ( defined $hash{'issn'} ) { + my $issn = propre($hash{'issn'}); + $query .= " AND " if $query; + $query .= "host.issn:\"$issn\""; + } + +if ( defined $hash{'publicationDate'} ) { + my $pdate = propre($hash{'publicationDate'}); + $query .= " AND " if $query; + $query .= "host.publicationDate:\"$pdate\""; + } +elsif ( defined $hash{'copyrightDate'} ) { + my $cdate = propre($hash{'copyrightDate'}); + $query .= " AND " if $query; + $query .= "host.copyrightDate:\"$cdate\""; + } + +if ( defined $hash{'volume'} ) { + my $volume = propre($hash{'volume'}); + $query .= " AND " if $query; + if ( $volume =~ /^\d+\z/o ) { + $query .= "host.volume:\"$volume\""; + } + else { + $query .= "host.volume.raw:\"$volume\""; + } + } + +if ( defined $hash{'fascicule'} ) { + my $fascicule = propre($hash{'fascicule'}); + $query .= " AND " if $query; + if ( $fascicule =~ /^\d+\z/o ) { + $query .= "host.issue:$fascicule"; + } + else { + $query .= "host.issue.raw:\"$fascicule\""; + } + } + +if ( defined $hash{'pagedebut'} and + defined $hash{'pagefin'} ) { + my $pagedebut = propre($hash{'pagedebut'}); + my $pagefin = propre($hash{'pagefin'}); + $query .= " AND " if $query; + if ( $pagedebut =~ /^\d+\z/o and $pagefin =~ /^\d+\z/o ) { + $query .= "host.pages.first:[$pagedebut TO $pagefin]"; + $query .= " AND host.pages.last:[$pagedebut TO $pagefin]"; + } + else { + $query .= "host.pages.first.raw:[$pagedebut TO $pagefin]"; + $query .= " AND host.pages.last.raw:[$pagedebut TO $pagefin]"; + } + } + +## Envoi de la requête +print "ALT : \"$url$query&$out\"\n"; + +my $perl = get_hits($query); +if ( defined $perl ) { + my %top = %{$perl}; + if ( $top{'total'} >= 1 ) { + foreach my $hit (@{$top{'hits'}}) { + my %hit = %{$hit}; + my $id = $hit{'id'}; + my $ark = $hit{'arkIstex'}; + my $titre = $hit{'title'}; + my $doi = 'N/A'; + if ( defined $hit{'doi'} ) { + $doi = $hit{'doi'}->[0]; + } + my @auteurs = (); + if ( $hit{'author'} ) { + foreach my $auteur (@{$hit{'author'}}) { + if ( defined $auteur->{'name'} ) { + push(@auteurs, $auteur->{'name'}); + } + } + } + if ( $hit{'host'} ) { + my %host = %{$hit{'host'}}; + if ( defined $host{'pages'} ) { + my ($debut, $fin) = (undef, undef); + if ( defined $host{'pages'}->{'first'} ) { + $debut = $host{'pages'}->{'first'}; + } + if ( defined $host{'pages'}->{'last'} ) { + $fin = $host{'pages'}->{'last'}; + } + if ( $debut and $fin ) { + my $tmp = "$debut\t$fin\t"; + $tmp .= join("|", @auteurs); + $tmp .= "\t$titre\t$id\t$ark\t$doi"; + push(@liste, $tmp); + } + } + } + } + } + } + +return @liste; +} + +sub revue +{ +my ($title, @liste) = @_; + +my $match = 0; + +my $rv = lc(join(" ", ($title =~ /(\w+)/go))); +foreach my $item (@liste) { + my $jn = decode_entities($item); + if ( $jn eq $title or lc($jn) eq lc($title) ) { + $match ++; + } + else { + my $tmp = lc(join(" ", ($jn =~ /(\w+)/go))); + if ( $tmp eq $rv ) { + $match ++; + } + elsif ( $tmp =~ / [a-z]\z/o and $rv =~ /^$tmp / ) { + $match ++; + print "\t -> $num\t$tmp\t$rv\n" if not $modifs{"$tmp\t$rv"}; + $modifs{"$tmp\t$rv"} ++; + } + elsif ( $rv =~ / [a-z]\z/o and $tmp =~ /^$rv / ) { + $match ++; + print "\t -> $num\t$tmp\t$rv\n" if not $modifs{"$tmp\t$rv"}; + $modifs{"$tmp\t$rv"} ++; + } + else { + my $tmp1 = join(" ", grep(!/^(and|et|und|e|y)\z/, split(/ +/, $tmp))); + my $tmp2 = join(" ", grep(!/^(and|et|und|e|y)\z/, split(/ +/, $rv))); + if ( $tmp1 eq $tmp2 ) { + $match ++; + } + else { + $tmp1 =~ s/^(the|die|das|les?|la?|du|[ei]l) //o; + $tmp2 =~ s/^(the|die|das|les?|la?|du|[ei]l) //o; + $match ++ if $tmp1 eq $tmp2; + } + } + } + if ( not $match ) { + if ( $jn =~ /\s*: /o ) { + my ($tmp) = ($jn =~ /^(.+)\s*:/o); + if ( $tmp eq $title or lc($tmp) eq lc($title) ) { + $match ++; + } + } + if ( $title =~ /\s*: /o ) { + my ($tmp) = ($title =~ /^(.+)\s*:/o); + if ( $jn eq $tmp or lc($jn) eq lc($tmp) ) { + $match ++; + } + } + } + } + +return $match; +} + + +__DATA__ + +## +## NE PAS MODIFIER ! +## +## DO NOT EDIT! +## + +33 excl +34 dquot +35 num +36 dollar +37 percnt +40 lpar +41 rpar +42 ast +43 plus +44 comma +45 hyphen +46 period +47 sol +58 colon +59 semi +61 equals +63 quest +64 commat +91 lsqb +92 bsol +93 rsqb +95 lowbar +96 grave +123 lcub +124 verbar +256 Amacr; +257 amacr; +258 Abreve; +259 abreve; +260 Aogon; +261 aogon; +262 Cacute; +263 cacute; +264 Ccirc; +265 ccirc; +266 Cdot; +267 cdot; +268 Ccaron; +269 ccaron; +270 Dcaron; +271 dcaron; +272 Dstrok; +273 dstrok; +274 Emacr; +275 emacr; +278 Edot; +279 edot; +280 Eogon; +281 eogon; +282 Ecaron; +283 ecaron; +284 Gcirc; +285 gcirc; +286 Gbreve; +287 gbreve; +288 Gdot; +289 gdot; +290 Gcedil; +291 gcedil; +292 Hcirc; +293 hcirc; +294 Hstrok; +295 hstrok; +296 Itilde; +297 itilde; +298 Imacr; +299 imacr; +302 Iogon; +303 iogon; +304 Idot; +305 inodot; +306 IJlig; +307 ijlig; +308 Jcirc; +309 jcirc; +310 Kcedil; +311 kcedil; +312 kgreen; +313 Lacute; +314 lacute; +315 Lcedil; +316 lcedil; +317 Lcaron; +318 lcaron; +319 Lmidot; +320 lmidot; +321 Lstrok; +322 lstrok; +323 Nacute; +324 nacute; +325 Ncedil; +326 ncedil; +327 Ncaron; +328 ncaron; +329 napos; +330 ENG; +331 eng; +332 Omacr; +333 omacr; +336 Odblac; +337 odblac; +340 Racute; +341 racute; +342 Rcedil; +343 rcedil; +344 Rcaron; +345 rcaron; +346 Sacute; +347 sacute; +348 Scirc; +349 scirc; +350 Scedil; +351 scedil; +354 Tcedil; +355 tcedil; +356 Tcaron; +357 tcaron; +358 Tstrok; +359 tstrok; +360 Utilde; +361 utilde; +362 Umacr; +363 umacr; +364 Ubreve; +365 ubreve; +366 Uring; +367 uring; +368 Udblac; +369 udblac; +370 Uogon; +371 uogon; +372 Wcirc; +373 wcirc; +374 Ycirc; +375 ycirc; +377 Zacute; +378 zacute; +379 Zdot; +380 zdot; +381 Zcaron; +382 zcaron; +501 gacute; +711 caron; +728 breve; +729 dot; +730 ring; +731 ogon; +733 dblac; +902 Aacgr; +904 Eacgr; +905 EEacgr; +906 Iacgr; +908 Oacgr; +910 Uacgr; +911 OHacgr; +912 idiagr; +913 Agr; +914 Bgr; +915 Ggr; +916 Dgr; +917 Egr; +918 Zgr; +919 EEgr; +920 THgr; +921 Igr; +922 Kgr; +923 Lgr; +924 Mgr; +925 Ngr; +926 Xgr; +927 Ogr; +928 Pgr; +929 Rgr; +931 Sgr; +932 Tgr; +933 Ugr; +934 PHgr; +935 KHgr; +936 PSgr; +937 OHgr; +938 Idigr; +939 Udigr; +940 aacgr; +941 eacgr; +942 eeacgr; +943 iacgr; +944 udiagr; +945 agr; +946 bgr; +947 ggr; +948 dgr; +949 egr; +950 zgr; +951 eegr; +952 thgr; +953 igr; +954 kgr; +955 lgr; +956 mgr; +957 ngr; +958 xgr; +959 ogr; +960 pgr; +961 rgr; +962 sfgr; +963 sgr; +964 tgr; +965 ugr; +966 phgr; +967 khgr; +968 psgr; +969 ohgr; +970 idigr; +971 udigr; +972 oacgr; +973 uacgr; +974 ohacgr; +977 thetav; +981 phiv; +988 gammad; +1008 kappav; +1009 rhov; +1025 IOcy; +1026 DJcy; +1027 GJcy; +1028 Jukcy; +1029 DScy; +1030 Iukcy; +1031 YIcy; +1032 Jsercy; +1033 LJcy; +1034 NJcy; +1035 TSHcy; +1036 KJcy; +1038 Ubrcy; +1039 DZcy; +1040 Acy; +1041 Bcy; +1042 Vcy; +1043 Gcy; +1044 Dcy; +1045 IEcy; +1046 ZHcy; +1047 Zcy; +1048 Icy; +1049 Jcy; +1050 Kcy; +1051 Lcy; +1052 Mcy; +1053 Ncy; +1054 Ocy; +1055 Pcy; +1056 Rcy; +1057 Scy; +1058 Tcy; +1059 Ucy; +1060 Fcy; +1061 KHcy; +1062 TScy; +1063 CHcy; +1064 SHcy; +1065 SHCHcy; +1066 HARDcy; +1067 Ycy; +1068 SOFTcy; +1069 Ecy; +1070 YUcy; +1071 YAcy; +1072 acy; +1073 bcy; +1074 vcy; +1075 gcy; +1076 dcy; +1077 iecy; +1078 zhcy; +1079 zcy; +1080 icy; +1081 jcy; +1082 kcy; +1083 lcy; +1084 mcy; +1085 ncy; +1086 ocy; +1087 pcy; +1088 rcy; +1089 scy; +1090 tcy; +1091 ucy; +1092 fcy; +1093 khcy; +1094 tscy; +1095 chcy; +1096 shcy; +1097 shchcy; +1098 hardcy; +1099 ycy; +1100 softcy; +1101 ecy; +1102 yucy; +1103 yacy; +1105 iocy; +1106 djcy; +1107 gjcy; +1108 jukcy; +1109 dscy; +1110 iukcy; +1111 yicy; +1112 jsercy; +1113 ljcy; +1114 njcy; +1115 tshcy; +1116 kjcy; +1118 ubrcy; +1119 dzcy; +8196 emsp13; +8197 emsp14; +8199 numsp; +8200 puncsp; +8202 hairsp; +8208 dash; +8211 ndash; +8212 mdash; +8213 horbar; +8214 Verbar; +8229 nldr; +8244 tprime; +8245 bprime; +8257 caret; +8259 hybull; +8411 tdot; +8412 DotDot; +8453 incare; +8459 hamilt; +8463 planck; +8466 lagran; +8467 ell; +8470 numero; +8471 copysr; +8478 rx; +8486 ohm; +8491 angst; +8492 bernou; +8499 phmmat; +8500 order; +8502 beth; +8503 gimel; +8504 daleth; +8531 frac13; +8532 frac23; +8533 frac15; +8534 frac25; +8535 frac35; +8536 frac45; +8537 frac16; +8538 frac56; +8539 frac18; +8540 frac38; +8541 frac58; +8542 frac78; +8597 varr; +8598 nwarr; +8599 nearr; +8600 drarr; +8601 dlarr; +8602 nlarr; +8603 nrarr; +8605 rarrw; +8606 Larr; +8608 Rarr; +8610 larrtl; +8611 rarrtl; +8614 map; +8617 larrhk; +8618 rarrhk; +8619 larrlp; +8620 rarrlp; +8621 harrw; +8622 nharr; +8624 lsh; +8625 rsh; +8630 cularr; +8631 curarr; +8634 olarr; +8635 orarr; +8636 lharu; +8637 lhard; +8638 uharr; +8639 uharl; +8640 rharu; +8641 rhard; +8642 dharr; +8643 dharl; +8644 rlarr2; +8646 lrarr2; +8647 larr2; +8648 uarr2; +8649 rarr2; +8650 darr2; +8651 lrhar2; +8652 rlhar2; +8653 nlArr; +8654 nhArr; +8655 nrArr; +8661 vArr; +8666 lAarr; +8667 rAarr; +8705 comp; +8708 nexist; +8714 epsis; +8717 bepsi; +8720 coprod; +8722 minus; +8723 mnplus; +8724 plusdo; +8726 setmn; +8728 compfn; +8735 ang90; +8737 angmsd; +8738 angsph; +8739 mid; +8740 nmid; +8741 par; +8742 npar; +8750 conint; +8757 becaus; +8765 bsim; +8768 wreath; +8769 nsim; +8771 sime; +8772 nsime; +8775 ncong; +8777 nap; +8778 ape; +8780 bcong; +8782 bump; +8783 bumpe; +8784 esdot; +8785 eDot; +8786 efDot; +8787 erDot; +8788 colone; +8789 ecolon; +8790 ecir; +8791 cire; +8793 wedgeq; +8796 trie; +8802 nequiv; +8806 lE; +8807 gE; +8808 lne; +8809 gne; +8810 Lt; +8811 Gt; +8812 twixt; +8814 nlt; +8815 ngt; +8816 nle; +8817 nge; +8818 lsim; +8819 gsim; +8822 lg; +8823 gl; +8826 pr; +8827 sc; +8828 pre; +8829 sce; +8830 prsim; +8831 scsim; +8832 npr; +8833 nsc; +8837 nsup; +8840 nsube; +8841 nsupe; +8842 subne; +8843 supne; +8846 uplus; +8847 sqsub; +8848 sqsup; +8849 sqsube; +8850 sqsupe; +8851 sqcap; +8852 sqcup; +8854 ominus; +8856 osol; +8857 odot; +8858 ocir; +8859 oast; +8861 odash; +8862 plusb; +8863 minusb; +8864 timesb; +8865 sdotb; +8866 vdash; +8867 dashv; +8868 top; +8871 models; +8872 vDash; +8873 Vdash; +8874 Vvdash; +8876 nvdash; +8877 nvDash; +8878 nVdash; +8879 nVDash; +8882 vltri; +8883 vrtri; +8884 ltrie; +8885 rtrie; +8888 mumap; +8890 intcal; +8891 veebar; +8892 barwed; +8900 diam; +8902 sstarf; +8903 divonx; +8904 bowtie; +8905 ltimes; +8906 rtimes; +8907 lthree; +8908 rthree; +8909 bsime; +8910 cuvee; +8911 cuwed; +8912 Sub; +8913 Sup; +8914 Cap; +8915 Cup; +8916 fork; +8918 ldot; +8919 gsdot; +8920 Ll; +8921 Gg; +8922 leg; +8923 gel; +8924 els; +8925 egs; +8926 cuepr; +8927 cuesc; +8928 npre; +8929 nsce; +8934 lnsim; +8935 gnsim; +8936 prnsim; +8937 scnsim; +8938 nltri; +8939 nrtri; +8940 nltrie; +8941 nrtrie; +8942 vellip; +8966 Barwed; +8972 drcrop; +8973 dlcrop; +8974 urcrop; +8975 ulcrop; +8981 telrec; +8982 target; +8988 ulcorn; +8989 urcorn; +8990 dlcorn; +8991 drcorn; +8994 frown; +8995 smile; +9251 blank; +9416 oS; +9472 boxh; +9474 boxv; +9484 boxdr; +9488 boxdl; +9492 boxur; +9496 boxul; +9500 boxvr; +9508 boxvl; +9516 boxhd; +9524 boxhu; +9532 boxvh; +9552 boxH; +9553 boxV; +9554 boxdR; +9555 boxDr; +9556 boxDR; +9557 boxdL; +9558 boxDl; +9559 boxDL; +9560 boxuR; +9561 boxUr; +9562 boxUR; +9563 boxuL; +9564 boxUl; +9565 boxUL; +9566 boxvR; +9567 boxVr; +9568 boxVR; +9569 boxvL; +9570 boxVl; +9571 boxVL; +9572 boxHd; +9573 boxhD; +9574 boxHD; +9575 boxHu; +9576 boxhU; +9577 boxHU; +9578 boxvH; +9579 boxVh; +9580 boxVH; +9600 uhblk; +9604 lhblk; +9608 block; +9617 blk14; +9618 blk12; +9619 blk34; +9633 squ; +9642 squf; +9645 rect; +9646 marker; +9651 xutri; +9652 utrif; +9653 utri; +9656 rtrif; +9657 rtri; +9661 xdtri; +9662 dtrif; +9663 dtri; +9666 ltrif; +9667 ltri; +9675 cir; +9733 starf; +9734 star; +9742 phone; +9792 female; +9794 male; +9834 sung; +9837 flat; +9838 natur; +9839 sharp; +10003 check; +10007 cross; +10016 malt; +10022 lozf; +10038 sext; +64256 fflig; +64257 filig; +64258 fllig; +64259 ffilig; + +## +## The End! +## diff --git a/02-correction/README.md b/02-correction/README.md new file mode 100644 index 0000000..35155a5 --- /dev/null +++ b/02-correction/README.md @@ -0,0 +1,139 @@ +Correction de l’alignement Pascal-Francis / Istex +=============== + +Programme de correction de l’alignement des notices bibliographiques Inist avec les documents Istex + +Le programme `recupErreurs.pl` permet de corriger les erreurs apparues lors de l’alignement des bases bibliographiques Pascal et Francis de l’**Inist** avec la base **Istex** si elles sont dues à des problèmes de connexion à l’API **Istex** ou, à défaut, d’isoler les notices bibliographiques responsables d’une erreur de syntaxe lors de la génération de la requête à l’API. Dans ce dernier cas, le programme permet également après correction de ces notices de modifier le fichier de sortie du programme d’alignement `matchStan2Istex.pl` pour inclure les réponses correctes. + +À noter que si ce programme est utilisé à l'Inist, il est recommandé d’éviter de passer par le proxy. Pour cela, il faut supprimer les variables globales le définissant, ce qui se fait avec la commande  : `unset http_proxy https_proxy no_proxy`. Vérifiez également avec la commande `env` si ces mêmes variables n'existent pas en majuscule. Auquel cas, supprimez les avec la commande : `unset HTTP_PROXY HTTPS_PROXY NO_PROXY`. + + +### Usage + +```txt + recupErreurs_v3.pl -h hfd -a alignement -r rejet [ -l log ] [ -m matchStan ] + recupErreurs_v3.pl -f fichier -a alignement -r rejet [ -l log ] [ -m matchStan ] + recupErreurs_v3.pl -i +``` + + +### Options + + +``` + -a indique le nom du fichier de résultats de l’alignement dont on doit + corriger les erreurs + -f indique le nom du fichier d’entrée contenant les notices Pascal ou Francis + (qui peut être un fichier compressé avec “gzip” ou “bzip2”) + -h indique le nom du fichier HFD servant d’entrée au programme + -i affiche cette aide. + -l indique le nom du fichier “log” qui recevra, à la fois, le résultat avant + et après lorsqu’une notice traitée donnera un résultat différent + -m indique le nom et le chemin du programme d’alignement si ce n'est pas + celui par défaut + -r indique le nom du fichier contenant les notices Pascal ou Francis ayant + été modifiées parce que les notices originales ont provoqué une erreur +``` + + +### Correction + +#### 1 - Détection des erreurs + +Pour voir si votre fichier de résultats a des erreurs, un simple `grep` suffit. Pour le fichier `P95_out.txt` contenant les résultats bruts de Pascal 1995, la commande suivante permet de compter le nombre d’erreurs par type : +```bash +grep ' => ERREUR ' P95_out.txt | sort | uniq -c +``` +Si votre fichier est compressé avec `gzip`, cette commande devient : +```bash +gzip -cd P95_out.txt.gz | grep ' => ERREUR ' | sort | uniq -c +``` +Évidemment, s’il n’y a pas d’erreur, on s’arrête là. Autrement, on fait un premier passage avec `recupErreurs.pl` + +#### 2 - Premier passage + +Il consiste à traiter les mêmes notices Pascal ou Francis en indiquant dans quel fichier stocker les notices qui n'ont pas pu être corrigées. Si vous êtes parti du HFD des notices Pascal 1995 `Pascal.strd95.bib` et si vous compressez vos fichiers de résultats, la commande est : +```bash +recupErreurs.pl -h Pascal.strd95.bib -a P95_out.txt.gz -r rejetP95.txt | gzip -c9 > P95_out2.txt.gz +``` +Vous pouvez également créer un fichier de “log” avec l’option `-l` et vous devez donnez le nom, voire le chemin, du programme `matchStan2Istex.pl` si vous n’utilisez pas celui par défaut ou s’il n’est pas dans un répertoire déclaré dans la variable `PATH`. + +Si le fichier `rejetP95.txt` obtenu est vide, alors, la correction est terminée. Sinon, il faudra corriger les notices contenues dans ce fichier avant de passer à l’étape suivante. + +#### 3 - Deuxième passage + +La syntaxe de la commande est fondamentalement la même que pour le premier passage. Simplement, on substitue le nouveau fichier de résultats à l’ancien : +```bash +recupErreurs.pl -h Pascal.strd95.bib -a P95_out2.txt.gz -r rejetP95.txt | gzip -c9 > P95_out3.txt.gz +``` +Normalement, là, votre fichier de résultats est correct. En fait, on ne devrait plus avoir besoin de ce deuxième passage, comme il est dit plus bas. + + +### Types d’erreur + +#### 1 - Erreur de connexion + +Il arrive que la connexion à l’API ne se fasse pas ou qu’elle se passe mal. On obtient alors un code retour 500 avec différents messages d’erreur comme : + +```txt +500 Can't connect to api.istex.fr:443 (Bad hostname 'api.istex.fr') +500 Can't connect to api.istex.fr:443 (Échec temporaire dans la résolution du nom) +500 Internal Server Error +500 Status read failed: Connection reset by peer +500 Server closed connection without sending any data back +``` + +Dans certains cas, l’API renvoie effectivement une réponse, mais la connexion est coupée et on a un enregistrement JSON tronqué. L’analyse de cette réponse donnera également un message d’erreur : + +``` +ERREUR CONVERSION JSON -> PERL ! +``` + +Dans tous ces cas, on peut obtenir une réponse correcte en relançant l’alignement sur ces seules notices. + + +#### 2 - Erreur de syntaxe + +Certaines notices contiennent des champs avec une ou des erreurs qui font que la requête générée par le programme `matchStan2Istex.pl` ne suivra pas la syntaxe requise par l’API **Istex**. On a alors une erreur 400 : + +```txt +400 Bad Request +``` + +On trouve ces erreurs surtout dans les numéros de volume ou de fascicule ou dans les noms d’auteur, mais pas seulement. Dans l’exemple suivant, tiré de la notice Pascal `90-0351247`, le champ correspondant au deuxième auteur est : + +```sgml +AVIL#A (J. G. A.) +``` +Pour rappel, les notices ne sont pas en XML, mais en SGML et utilise des entités caractères pour les caractères accentués et les symboles. L’entité caractère `#` correspond au caractère dièse `#`. La partie de la requête consacrée aux auteur est alors : + +```txt +author.name:("PEREZ" OR "AVIL#A" OR "MARTINEZ") +``` + +Ce caractère `#` qui n'est pas encodé en `%23` provoque une erreur immédiate. + +Mais, normalement, **ce genre d’erreur ne devrait plus arriver** parce que la totalité des notices à l’origine de ces messages `400 Bad Request` ont été corrigées. + + +### Fichiers générés par `recupErreurs.pl` + +#### 1 - Fichier de notices rejetées + +Le nom de ce fichier est donné par l’option `-r`. Il contient pour chaque notice ayant donné une erreur 400 : + + - la requête générée par le programme `matchStan2Istex.pl` mise en commentaire + - la notice Inist au format Inist 1994 SGML + +La présence de la requête permet de la tester sur un navigateur Internet et, ainsi, trouver l’erreur. La notice pourra ensuite être corrigée (ce qui demande une bonne connaissance du format). + +Après correction, ce même fichier pourra être utilisé pour corriger le résultat de l’alignement. + +#### 2 - Fichier en sortie standard + +Ce fichier est strictement identique dans sa forme au fichier produit par le programme `matchStan2Istex.pl`. + +#### 3 - Fichier de “log” + +Ce fichier est optionnel. Si vous l’avez demandé avec l’option `-l`, vous obtiendrez, pour chaque notice testée, l’identifiant Inist de la notice et, si une modification a eu lieu, le résultat de l’alignement avant et après. + diff --git a/02-correction/recupErreurs.pl b/02-correction/recupErreurs.pl new file mode 100755 index 0000000..e798454 --- /dev/null +++ b/02-correction/recupErreurs.pl @@ -0,0 +1,368 @@ +#!/usr/bin/perl + + +# Déclaration des pragmas +use strict; +use utf8; +use open qw/:std :utf8/; + +# Appel des modules externes de base +use Encode; +use Getopt::Long; + +# Appel des modules spécifiques à l'application +# ??? + +my ($programme) = $0 =~ m|^(?:.*/)?(.+)|; +my $version = "3.1.5"; +my $dateModif = "26 Février 2021"; + +my $usage = "Usage : \n" . + " $programme -h hfd -a alignement -r rejet [ -l log ] [ -m matchStan ] \n" . + " $programme -f fichier -a alignement -r rejet [ -l log ] [ -m matchStan ] \n" . + " $programme -i \n"; + +my $alignement = undef; +my $fichier = undef; +my $hfd = undef; +my $info = undef; +my $log = undef; +my $rejet = undef; +my $matchStan = "matchStan2Istex_v12c.pl"; + +eval { + $SIG{__WARN__} = sub {usage(1);}; + GetOptions( + "alignement=s" => \$alignement, + "fichier=s" => \$fichier, + "hfd=s" => \$hfd, + "info" => \$info, + "log=s" => \$log, + "rejet=s" => \$rejet, + "match=s" => \$matchStan, + ); + }; +$SIG{__WARN__} = sub {warn $_[0];}; + +if ( $info ) { + print "Programme : \n"; + print " “$programme”, version $version ($dateModif)\n"; + print " Permet de chercher les erreurs dans le fichier de résultats obtenu \n"; + print " avec le programme “$matchStan” et de les corriger. \n"; + print "\n"; + print $usage; + print "\nOptions : \n"; + print " -a indique le nom du fichier de résultats de l’alignement dont on doit \n"; + print " corriger les erreurs \n"; + print " -f indique le nom du fichier d’entrée contenant les notices Pascal ou Francis \n"; + print " (qui peut être un fichier compressé avec “gzip” ou “bzip2”) \n"; + print " -h indique le nom du fichier HFD servant d’entrée au programme \n"; + print " -i affiche cette aide. \n"; + print " -l indique le nom du fichier qui recevra, à la fois, le résultat avant et \n"; + print " après lorsqu’une notice traitée donnera un résultat différent \n"; + print " -m indique le nom du programme d’alignement si ce n'est pas celui par défaut \n"; + print " -r indique le nom du fichier contenant les notices Pascal ou Francis ayant \n"; + print " été modifiées parce que les notices originales ont provoqué une erreur \n"; + print " \n"; + print "N.B. : pour ne pas passer par le proxy sur le réseau interne de l’INIST, il faut \n"; + print " effacer les variables globales du proxy par la commande “unset http_proxy \n"; + print " https_proxy no_proxy” avant de lancer le programme “$programme”. \n"; + print " \n"; + + exit 0; + } + +usage(2) if not $alignement or not $rejet; +usage(2) if not $fichier and not $hfd; +usage(2) if $fichier and $hfd; + +if ( $hfd and not -d $hfd ) { + print STDERR "Fichier HFD \"$hfd\" absent !\n"; + exit(3); + } + +# Variables +my $blancs = 0; +my $temp = "rEtmp$$.sgml"; +my @lignes = (); +my %correct = (); +my %notice = (); + +# Gestion des interruptions +$SIG{'HUP'} = 'nettoie'; +$SIG{'INT'} = 'nettoie'; +$SIG{'QUIT'} = 'nettoie'; +$SIG{'TERM'} = 'nettoie'; + +if ( $rejet ) { + if ( -f $rejet ) { + open(INP, "<:raw", $rejet) or die "$!,"; + while() { + next if /^\s*$/o; + next if /^#/o; + my ($inist) = m|(.+?)|o; + $correct{$inist} = $_; + } + close INP; + } + } + +if ( defined $fichier ) { + if ( $fichier eq '-' ) { + open(REC, "<&STDIN") or die "$!,"; + binmode(REC, ":raw"); + } + elsif ( $fichier =~ /\.gz\z/o ) { + open(REC, "gzip -cd $fichier |") or die "$!,"; + binmode(REC, ":raw"); + } + elsif ( $fichier =~ /\.bz2\z/o ) { + open(REC, "bzip2 -cd $fichier |") or die "$!,"; + binmode(REC, ":raw"); + } + else { + open(REC, "<:raw", $fichier) or die "$!,"; + } + } +elsif ( defined $hfd ) { + open(REC, "IhfdCat $hfd |") or die "$!,"; + binmode(REC, ":raw"); + } + +my ($rec, $inist, $refaire) = suivant(); + +open(LOG, ">:utf8", $log) or die "$!,"; + +if ( $alignement =~ /\.gz\z/o ) { + open(INP, "gzip -cd $alignement |") or die "$!,"; + binmode(INP, ":utf8"); + } +elsif ( $alignement =~ /\.bz2\z/o ) { + open(INP, "bzip2 -cd $alignement |") or die "$!,"; + binmode(INP, ":utf8"); + } +else { + open(INP, "<:utf8", $alignement) or die "$!,"; + } +while() { + if ( /^\s*$/o ) { + $blancs ++; + if ( @lignes ) { + passe(@lignes); + @lignes = (); + print "\n"; + } + else { + print $_ if $blancs == 1; + } + } + else { + push(@lignes, $_); + $blancs = 0; + } + } +close INP; + +if ( @lignes ) { + passe(@lignes); + } + + +exit 0; + + +sub usage +{ +print STDERR $usage; + +exit shift; +} + +sub suivant +{ +my $ligne = ; + +if ( defined $ligne ) { + my ($id) = $ligne =~ m|(.+?)|o; + if ( $correct{$id} ) { + $ligne = $correct{$id}; + } + my $status = erreur($ligne); + return ($ligne, $id, $status); + } + +return (undef, undef, undef); +} + +sub erreur +{ +my $ligne = shift; + +if ( m|(.+?)|o ) { + my $champ = $1; + my $pages = ""; + if ( $champ =~ m|(.+?)|o ) { + $pages = $1; + } + elsif ( $champ =~ m|(.+?)|o ) { + $pages = $1; + } + if ( $pages ) { + $pages =~ s|•|.|go; + $pages =~ s|−|-|go; + $pages =~ s|/|/|go; + $pages =~ s/^ +//o; + if ( $pages =~ /^(&\w+gr; )?vol\. *\S+?, */io or + $pages =~ /^(&\w+gr; )?vol \S+?, */io or + $pages =~ /^(&\w+gr; )?vol\d+, */io or + $pages =~ /^&\w+gr;,? */o ) { + $pages = $'; + } + if ( $pages =~ / *[.+?(].*)?.*\z/io or + $pages =~ / +\d+ p\.].*/io ) { + $pages = $`; + } + if ( $pages =~ / *\(.+?\).*\z/io ) { + $pages = $`; + } + if ( $pages =~ /^([0ivx][ivx]*(-[ivx]+)?,? *([ivx]+(-[ivx]+)?,? *)*) (.+)\z/io ) { + $pages = $5; + } + if ( $pages =~ /^s\.p\.\s*\z/io ) { + return 0; + } + elsif ( $pages =~ /^(\d+)-(\d+) +p\./io ) { + return 0; + } + elsif ( $pages =~ /^\S+ +p\./io ) { + return 0; + } + elsif ( $pages =~ /^p\. *(\S+)\z/io ) { + return 0; + } + elsif ( $pages =~ /^(\S+-\S+)-(\S+-\S+)\z/o ) { + return 0; + } + elsif ( $pages =~ /^(\S+?)(-\S+)?,( *(\S+-)?(\S+),)* *(\S+-)?(\S+) *\z/o ) { + return 1; + } + } + } + +return 0; +} + +sub passe +{ +my @liste = @_; + +foreach my $ligne (@liste) { + if ( $ligne =~ /^[_0\.\*\+]+[^\t]*\t(\d+\.\d+\W?|-)\t[AMC]\t(\d+(-\d+)+)\t/o ) { + my $valeur = $1; + my $id = $2; + while ( $id ne $inist ) { + ($rec, $inist, $refaire) = suivant(); + } + if ( $valeur =~ /^\d+\.\d+\z/o ) { + $refaire ++ if $valeur <= 4.000 and $valeur >= 3.490; + } + $refaire ++ if grep(/^\t => ERREUR /o, @liste) > 0; + if ( $refaire ) { + open(TMP, ">:raw", $temp) or die "$!,"; + print TMP $rec; + close TMP; + my $nb = 0; + my $ok = 0; + while( not $ok ) { + open(MSI, "$matchStan -f $temp |") or die "$!,"; + binmode(MSI, ":utf8"); + my @sortie = grep(/\S+/, ); + close MSI; + if ( grep(/^\t => ERREUR /o, @sortie) == 0 ) { + print @sortie; + compare($id, \@liste, \@sortie); + print STDERR "Notice \"$id\" modifiée \n"; + return; + } + elsif ( grep(/^\t => ERREUR 400 /o, @sortie) > 0 ) { + print @liste; + compare($id, \@liste, \@sortie); + print STDERR "Notice \"$id\" erreur 400 !\n"; + return; + } + else { + $nb ++; + if ( $nb >= 10 ) { + print STDERR "Problème notice \"$id\" !\n"; + print @liste; + return; + } + } + } + die "Impossible de supprimer \"$temp\" : $!," if not unlink $temp; + } + else { + print @liste; + } + return; + } + } + +print @liste; +} + +sub compare +{ +my ($id, $ref1, $ref2) = @_; + +my @liste1 = @{$ref1}; +my @liste2 = @{$ref2}; + +my ($score1, $score2) = (undef, undef); + +print LOG "===> $id <=== \n"; + +foreach my $ligne (@liste1) { + if ( $ligne =~ /^[_0\.\*\+]+[^\t]*\t(\d+\.\d+\W?|-)\t[AMC]\t(\d+(-\d+)+)\t/o ) { + $score1 = $1 + } + } + +foreach my $ligne (@liste2) { + if ( $ligne =~ /^[_0\.\*\+]+[^\t]*\t(\d+\.\d+\W?|-)\t[AMC]\t(\d+(-\d+)+)\t/o ) { + $score2 = $1 + } + } + +if ($#liste1 != $#liste2 or $score1 ne $score2 ) { + print LOG @liste1; + print LOG "-------------------- \n"; + print LOG @liste2; + } + +print LOG "\n"; +} + +sub nettoye +{ +my $signal = shift; + +if ( fileno(TMP) ) { + close TMP; + } +if ( -f "$temp" ) { + die "Impossible de supprimer \"$temp\" : $!," if not unlink $temp; + } + +if ( $signal =~ /^\d+\z/ ) { + exit $signal; + } +if ( $signal ) { + print STDERR "Signal SIG$signal détecté\n"; + exit 9; + } +else { + exit 0; + } +} + diff --git a/03-dedoublonnage/README.md b/03-dedoublonnage/README.md new file mode 100644 index 0000000..f6eedd4 --- /dev/null +++ b/03-dedoublonnage/README.md @@ -0,0 +1,51 @@ +Dédoublonnage de l’alignement Pascal-Francis / Istex +=============== + +Programme de dédoublonnage des résultats de l’alignement. + +Le programme `weedTei.pl` permet de repérer les doublons dans l’ensemble des fichiers de résultats de l’alignement et de choisir une notice **Inist** avec un score maximal pour chaque document **Istex** apparié. + + +### Usage + +```txt + weedTei3.pl -f fichier[,fichier]* -r répertoire [ -l log ] [ -x ] + weedTei3.pl -h +``` + +### Options + +```txt + -f indique le nom du ou des fichiers d’entrée (qui peuvent être des fichiers + compressés avec “gzip” ou “bzip2”). L’option est répétitive et il est possible + d’indiquer plusieurs noms de fichier en les séparant par des virgules (mais + sans espace entre eux). Si l’argument de l’option est un tiret “-”, alors la + liste des fichiers (pas leur contenu) est lue sur l’entrée standard + -h affiche cette aide + -l indique le nom du fichier “log” contenant la liste des appariements + supprimés + -r indique le nom du répertoire où seront créés les fichiers de sortie + portant le même nom que les fichiers d’entrée + -x accepte comme valides les appariements lorsque la valeur du score est + suivie d’un point d’exclamation (“!”) +``` + + +### Description + +Ce programme lit l'ensemble des fichiers de résultat de l’alignement, recherche les doublons avant de réécrire les fichiers dans un répertoire différent avec le même nom. Lorsqu’il y a un appariement en double, le programme choisit l'appariement avec le meilleur score et, en cas d’égalité, le premier traité. De ce fait, quand on compare un nouveau fichier aux anciens fichiers déjà dédoublonnés, il est préférable de faire passer les anciens fichiers en premier pour limiter les modifications dans ceux-ci. De la même façon, comme certaines notices de Pascal ont été reprises dans Francis, il est préférable de faire passer les fichiers Pascal en premier. +Dans les fichiers créés, les doublons rejetés sont marqués par un signe moins “-” ajouté après le score. Dans l’exemple suivant, on a le résultat pour 2 notices dont l’une est conservée, l’autre rejetée : + +```txt +***** 5.000 A 96-0127566 Adolescent pregnancy and subsequent obesity in african-american girls JOURNAL OF ADOLESCENT HEALTH ! ! ! 1994 15 6 491 494 SEGEL J.S. MCANARNEY, E.R. E47E5C8C67C62B0DA70B1CEF5AED43DA684A18DB ark:/67375/6H6-945TPDV9-D 10.1016/1054-139X(94)90497-Q 1054-139X(94)90497-Q 7811682 +****  4.444- A 95-0012606 Adolescent pregnancy and subsequent obesity in African-American girls Journal of adolescent health ! 1054-139X ! 1994 15 6 194 494 SEGEL J. S. MCANARNEY, E. R. E47E5C8C67C62B0DA70B1CEF5AED43DA684A18DB ark:/67375/6H6-945TPDV9-D 10.1016/1054-139X(94)90497-Q 1054-139X(94)90497-Q 7811682 +``` +Comme dans la documentation du programme `matchStan2Istex.pl`, les champs vides sont signalés par un point d’exclamation. + +Dans le cas de notices groupées où une notice décrit plusieurs articles, les doublons rejetés sont signalés en remplaçant la flèche en début de ligne ` ~~> ` par une flèche différente ` ::> `, comme dans l’exemple suivant : + +```txt + ::> 485 490 Christoph U. Lehmann M.D.|Jane Barr M.D.|Patricia J. Kelly M.D. Emergency department utilization by adolescents AE3EBD19A57CFD17B92295681E1B0F2FD4D62FAB ark:/67375/6H6-92BN6QVT-8 10.1016/1054-139X(94)90496-P 1054-139X(94)90496-P 7811681 + ::> 491 494 Jill S. Segel M.D.|Elizabeth R. McAnarney M.D. Adolescent pregnancy and subsequent obesity in African-American girls E47E5C8C67C62B0DA70B1CEF5AED43DA684A18DB ark:/67375/6H6-945TPDV9-D 10.1016/1054-139X(94)90497-Q 1054-139X(94)90497-Q 7811682 +``` + diff --git a/03-dedoublonnage/weedTei.pl b/03-dedoublonnage/weedTei.pl new file mode 100755 index 0000000..48f31f0 --- /dev/null +++ b/03-dedoublonnage/weedTei.pl @@ -0,0 +1,1414 @@ +#!/usr/bin/perl + + +# Déclaration des pragmas +use strict; +use utf8; +use open qw/:std :utf8/; + +# Appel des modules externes de base +use Encode; +use Getopt::Long; + +# Appel des modules spécifiques à l'application +use HTML::Entities qw(decode_entities %entity2char); +## use HTTP::CookieJar::LWP; +use JSON; +## use LWP::UserAgent; +use Text::Unidecode; +## use URI::Encode qw(uri_encode uri_decode); + +my ($programme) = $0 =~ m|^(?:.*/)?(.+)|; +my $Version = "1.5.1"; +my $dateModif = "10 Mars 2021"; + +my $usage = "Usage : \n" . + " $programme -f fichier[,fichier]* -r répertoire [ -l log ] [ -x ] \n" . + " $programme -h \n"; + +my $aide = undef; +my $log = undef; +my $rep = undef; +my $xclam = undef; +my @fichiers = (); +my %dejaVu = (); + +eval { + $SIG{__WARN__} = sub {usage(1);}; + GetOptions( + "fichier=s" => \@fichiers, + "help" => \$aide, + "log=s" => \$log, + "repertoire=s" => \$rep, + "xclam" => \$xclam, + ); + }; +$SIG{__WARN__} = sub {warn $_[0];}; + +if ( $aide ) { + print " \n"; + print "Programme : \n"; + print " “$programme”, version $Version ($dateModif)\n"; + print " Permet de créer les fichiers d’enrichissement avec les codes de classement \n"; + print " et les mots-clés Pascal ou Francis au format TEI StandOff \n"; + print "\n"; + print $usage; + print "\nOptions : \n"; + print " -f indique le nom du ou des fichiers d’entrée (qui peuvent être des fichiers \n"; + print " compressés avec “gzip” ou “bzip2”). L’option est répétitive et il est possible \n"; + print " d’indiquer plusieurs noms de fichier en les séparant par des virgules (mais \n"; + print " sans espace entre eux) \n"; + print " -h affiche cette aide \n"; + print " -l indique le nom du fichier “log” contenant la liste des appariements \n"; + print " supprimés \n"; + print " -r indique le nom du répertoire où seront créés les fichiers de sortie \n"; + print " portant le même nom que les fichiers d’entrée \n"; + print " -x accepte comme valides les appariements lorsque la valeur du score est \n"; + print " suivie d’un point d’exclamation (“!”) \n"; + print " \n"; + + exit 0; + } + +@fichiers = grep {not $dejaVu{$_} ++;} split(/,/, join(",", @fichiers)); +usage(2) if $#fichiers < 0; + +usage(2) if not $rep; + +# Récupération des noms de fichiers sur l'entrée standard +for ( my $nb = 0 ; $nb <= $#fichiers ; $nb ++ ) { + my $fichier = $fichiers[$nb]; + if ( $fichier eq '-' ) { + splice(@fichiers, $nb, 1); + while() { + chomp; + s/\r//o; + next if /^\s*$/o; + next if /^\s*-\s*$/o; + s/^\s+//o; + s/\s+$//o; + push(@fichiers, $_); + } + } + } + +# Variables +my $info = undef; +my $inist = undef; +my $nb = undef; +my $score = undef; +my %groupe = (); +my %info = (); +my %istex = (); +my %match = (); +my %rang = (); +my %rejetD = (); +my %rejetI = (); + +# Complétion de la table des entitées HTML +while() { + next if /^\s*$/o; + next if /^#/o; + chomp; + my ($num, $sgml) = split(/\t+/); + next if $entity2char{$sgml}; + $entity2char{$sgml} = chr($num); + } +close DATA; + +# Ouverture du fichier "log" +if ( $log ) { + open(LOG, ">:utf8", $log) or die "$!,"; + } +else { + open(LOG, ">:utf8", "/dev/null") or die "$!,"; + } + +foreach my $fichier (@fichiers) { + if ( $fichier =~ /\.gz\z/o ) { + open(INP, "gzip -cd $fichier |") or die "$!,"; + binmode(INP, ":utf8"); + } + elsif ( $fichier =~ /\.bz2\z/o ) { + open(INP, "bzip2 -cd $fichier |") or die "$!,"; + binmode(INP, ":utf8"); + } + else { + open(INP, "<:utf8", $fichier) or die "$!,"; + } + + while() { + if (/^([_.0\*\+]+\x{00A0}*)\t(\d\.\d+)(!?)\t/o) { + $score = $2; + my $statut = $3; + $statut = "" if not $xclam; + if ( $score < 3.490 and $statut ne '!' ) { + $inist = undef; + next; + } + chomp; + my @champs = split(/\t/); + $inist = $champs[3]; + my $id = $champs[17]; + $match{$id}{$inist} = $score; + $rang{$id}{$inist} = keys %{$match{$id}}; + $istex{$inist}{$id} = $score; + } + elsif (/^([_.0\*\+]+\x{00A0}*)\t(\d\.\d+)\W\t/o) { + $inist = undef; + } + elsif ( /^ ~~> \t/o ) { + next if not $inist; + chomp; + my @champs = split(/\t/); + my $id = $champs[5]; + next if defined $match{$id}{$inist}; + push(@{$groupe{$inist}}, "$id:$score"); + } + } + close INP; + + foreach $inist (sort keys %groupe) { + my @tmp = @{$groupe{$inist}}; + if ( $#tmp == 0 ) { + my ($id, $valeur) = split(/:/, $tmp[0]); + if ( $match{$id}{$inist} ) { + $rejetI{$inist}; + next; + } + } + my $erreur = 0; + foreach my $item (@tmp) { + my ($id, $valeur) = split(/:/, $item); + if ( defined $match{$id} ) { + my @inist = keys %{$match{$id}}; + $erreur ++ if @inist; + } + } + if ( $erreur ) { + $rejetI{$inist} ++; + } + else { + foreach my $item (@tmp) { + my ($id, $valeur) = split(/:/, $item); + $match{$id}{$inist} = $valeur; + } + } + } + } + +foreach my $id (keys %match) { + my @tmp = sort keys %{$match{$id}}; + if ( $#tmp == 0 ) { + delete $match{$id}; + next; + } + $nb ++; + foreach my $num (@tmp) { + $info{$num} ++; + } + } + +# print LOG "Nombre de doublons : $nb \n"; +# foreach my $id (sort keys %match) { +# print LOG " -> $id \n"; +# foreach my $num (sort keys %{$match{$id}}) { +# print LOG "\t$num => $match{$id}{$num} \n"; +# } +# } + +foreach my $fichier (@fichiers) { + if ( $fichier =~ /\.gz\z/o ) { + open(INP, "gzip -cd $fichier |") or die "$!,"; + binmode(INP, ":utf8"); + } + elsif ( $fichier =~ /\.bz2\z/o ) { + open(INP, "bzip2 -cd $fichier |") or die "$!,"; + binmode(INP, ":utf8"); + } + else { + open(INP, "<:utf8", $fichier) or die "$!,"; + } + + while() { + if (/^([_.0\*\+]+\x{00A0}*)\t/o) { + chomp; + my @champs = split(/\t/); + $inist = $champs[3]; + $info = join("\t", @champs[4 .. 16]); +# my $id = $champs[17]; + $info{$inist} = $info if $info{$inist}; + } + } + close INP; + } + +foreach my $id (sort keys %match) { + my %tmp = (); + next if not defined $match{$id}; + foreach my $num (sort keys %{$match{$id}}) { + push(@{$tmp{$match{$id}{$num}}}, $num); + } + my @tmp = sort {$b <=> $a} keys %tmp; + next if $#tmp < 0; + my $max = $tmp[0]; + if ( $#{$tmp{$max}} == 0 ) { + my $correct = $tmp{$max}->[0]; + foreach my $num (sort keys %{$match{$id}}) { + next if $num eq $correct; + $rejetD{$num} ++; + } + } + else { + @tmp = sort {$rang{$id}{$a} <=> $rang{$id}{$b}} @{$tmp{$max}}; + my $total = 0; + for (my $nb = 1 ; $nb <= $#tmp ; $nb ++) { + if ( $info{$tmp[0]} eq $info{$tmp[$nb]} ) { + $total ++; + next; + } + if ( compare($tmp[0], $tmp[$nb]) ) { + $total ++; + next; + } + last; + } + if ( $total == $#tmp ) { + foreach my $num (sort keys %{$match{$id}}) { + next if $num eq $tmp[0]; + $rejetD{$num} ++; + } + } + elsif ( $total > 1 and $total == $#tmp - 1 ) { + print LOG " => $id [$max] \n"; + foreach my $num (@{$tmp{$max}}) { + $rejetD{$num} ++; + print LOG "\t$num\t$info{$num}\n"; + } + print LOG "\n"; + } + else { + print LOG " -> $id [$max] \n"; + foreach my $num (@{$tmp{$max}}) { + $rejetD{$num} ++; + print LOG "\t$num\t$info{$num}\n"; + } + print LOG "\n"; + } + } + } + +foreach my $fichier (@fichiers) { + my $compression = undef; + if ( $fichier =~ /\.gz\z/o ) { + $compression = "gzip"; + open(INP, "gzip -cd $fichier |") or die "$!,"; + binmode(INP, ":utf8"); + } + elsif ( $fichier =~ /\.bz2\z/o ) { + $compression = "bzip2"; + open(INP, "bzip2 -cd $fichier |") or die "$!,"; + binmode(INP, ":utf8"); + } + else { + open(INP, "<:utf8", $fichier) or die "$!,"; + } + + if ( $compression ) { + open(OUT, "| $compression -c > $rep/$fichier") or die "$!,"; + binmode(OUT, ":utf8"); + } + else { + open(OUT, ">:utf8", "$rep/$fichier") or die "$!,"; + } + + while() { + if (/^([_.0\*\+]+\x{00A0}*)\t(\d\.\d+)(!?)\t/o) { + my $score = $2; + my $statut = $3; + my @champs = split(/\t/); + $inist = $champs[3]; + if ( $rejetD{$inist} ) { + $champs[1] = $score . '-'; + $_ = join("\t", @champs); + } + } + elsif (/^([_.0\*\+]+\x{00A0}*)\t(\d\.\d+)(\W?)\t/o) { + $inist = undef; + } + elsif ( /^ ~~> \t/o ) { + if ( $inist and $rejetI{$inist} ) { + s/^ ~~> \t/ ::> \t/o; + } + } + print OUT; + } + close INP; + close OUT; + } + +exit 0; + + +sub usage +{ +print STDERR "\n$usage\n"; + +exit shift; +} + +sub compare +{ +my ($n1, $n2) = @_; + +my $test = 0; +my %trouve = (); + +my @i1 = split(/\t/, $info{$n1}); +my @i2 = split(/\t/, $info{$n2}); +# 0 : titre ; 1 : journal ; 2 : livre ; 3 : $issn ; 4 : isbn ; 5 : date +# 6 : volume ; 7 : fascicule ; 8 : pagedebut ; 9 : pagefin ; 10 : nom1 +# 11 : prenom1 ; 12 : autres + +# ISSN +if ( $i1[3] and $i2[3] ) { + $test ++; + if ( $i1[3] eq $i2[3] or uc($i1[3]) eq uc($i2[3]) ) { + $trouve{'ISSN'} ++; + } + } + +# Revue +if ( $i1[1] and $i2[1] ) { + $test ++; + $trouve{'revue'} ++ if revue($i1[1], $i2[1]); + } + +# Date +if ( $i1[5] and $i2[5] ) { + $test ++; + if ( $i1[5] == $i2[5] or $i1[5] eq $i2[5] ) { + $trouve{'date'} ++; + } + } + +# Volume +if ( $i1[6] and $i2[6] ) { + $test ++; + if ( $i1[6] eq $i2[6] or biniou($i1[6], $i2[6], "VOLUME", $n1, $n2) ) { + $trouve{'volume'} ++; + } + elsif ( unidecode($i1[6]) eq unidecode($i2[6]) ) { + $trouve{'volume'} ++; + } + } + +# Fascicule +if ( $i1[7] and $i2[7] ) { + $test ++; + if ( $i1[7] eq $i2[7] or biniou($i1[7], $i2[7], "FASCICULE", $n1, $n2) ) { + $trouve{'fascicule'} ++; + } + elsif ( unidecode($i1[7]) eq unidecode($i2[7]) ) { + $trouve{'fascicule'} ++; + } + } + +# Page de début +if ( $i1[8] and $i2[8] ) { + $test ++; + $trouve{'pagedebut'} ++ if $i1[8] == $i2[8] or $i1[8] eq $i2[8]; + } + +# Page de fin +if ( $i1[9] and $i2[9] ) { + $test ++; + $trouve{'pagefin'} ++ if $i1[9] == $i2[9] or $i1[9] eq $i2[9]; + } + +# Titre du document +if ( $i1[0] and $i2[0] ) { + $test ++; + if ( ($trouve{'ISSN'} or $trouve{'revue'}) and + ($trouve{'date'} or $trouve{'volume'}) and + ($trouve{'pagedebut'} or $trouve{'pagefin'}) ) { + $trouve{'titre'} += titre($i1[0], $i2[0], 1); + } + else { + $trouve{'titre'} += titre($i1[0], $i2[0], 0); + } + } + +# Premier auteur +if ( $i1[10] and $i2[10] ) { + $test ++; + if ( $i1[10] eq $i2[10] or + uc($i1[10]) eq uc($i2[10]) ) { + $trouve{'auteur'} ++; + } + } + +my $trouve = scalar keys %trouve; + +if ( $test > 4 and $trouve == $test ) { + return 1; + } + +if ( ($trouve{'ISSN'} or $trouve{'revue'}) and + ($trouve{'date'} or $trouve{'volume'}) and + ($trouve{'pagedebut'} or $trouve{'pagefin'}) and + ($trouve{'auteur'} or $trouve{'titre'}) ) { + return 1; + } + +return 0; +} + +sub revue +{ +my ($title, @liste) = @_; + +my $match = 0; + +my $rv = lc(join(" ", ($title =~ /(\w+)/go))); +foreach my $item (@liste) { + my $jn = decode_entities($item); + if ( $jn eq $title or lc($jn) eq lc($title) ) { + $match ++; + } + else { + my $tmp = lc(join(" ", ($jn =~ /(\w+)/go))); + if ( $tmp eq $rv ) { + $match ++; + } + elsif ( $tmp =~ / [a-z]\z/o and $rv =~ /^$tmp / ) { + $match ++; + } + elsif ( $rv =~ / [a-z]\z/o and $tmp =~ /^$rv / ) { + $match ++; + } + else { + my $tmp1 = join(" ", grep(!/^(and|et|und|e|y)\z/, split(/ +/, $tmp))); + my $tmp2 = join(" ", grep(!/^(and|et|und|e|y)\z/, split(/ +/, $rv))); + if ( $tmp1 eq $tmp2 ) { + $match ++; + } + else { + $tmp1 =~ s/^(the|die|das|les?|la?|du|[ei]l) //o; + $tmp2 =~ s/^(the|die|das|les?|la?|du|[ei]l) //o; + $match ++ if $tmp1 eq $tmp2; + } + } + } + if ( not $match ) { + if ( $jn =~ /\s*: /o ) { + my ($tmp) = ($jn =~ /^(.+)\s*:/o); + if ( $tmp eq $title or lc($tmp) eq lc($title) ) { + $match ++; + } + } + if ( $title =~ /\s*: /o ) { + my ($tmp) = ($title =~ /^(.+)\s*:/o); + if ( $jn eq $tmp or lc($jn) eq lc($tmp) ) { + $match ++; + } + } + } + } + +return $match; +} + +sub biniou +{ +my ($val1, $val2, $champ, $num1, $num2) = @_; + +if ( $val1 =~ /^\d+\z/o ) { + if ( $val2 =~ /^(\d+)[-\x{2010}-\x{2015}\x{2212}](\d+)\z/o ) { + my $inf = $1; + my $sup = $2; + if ( $inf < $sup and $val1 >= $inf and $val1 <= $sup ) { + return 1; + } + } + } +elsif ( $val1 =~ m|^(\d+)[-\x{2010}-\x{2015}\x{2212}/](\d+)\z|o ) { + my $inf = $1; + my $sup = $2; + if ( $val2 =~ /^\d+\z/o ) { + if ( $inf < $sup and $val2 >= $inf and $val2 <= $sup ) { + return 1; + } + } + elsif ( $val2 =~ m|^(\d+)[-\x{2010}-\x{2015}\x{2212}/](\d+)\z|o ) { + my $inf2 = $1; + my $sup2 = $2; + if ( $inf == $inf2 and $sup == $sup2 ) { + return 1; + } + } + } +elsif ( $val1 =~ /^([A-Za-z]+)(\d+)\z/o ) { + my $vl = $1; + my $vn = $2; + if ( $val2 =~ /^([A-Za-z])(\d+)[-\x{2010}-\x{2015}\x{2212}]([A-Za-z])(\d+)\z/o ) { + my $infl = $1; + my $infn = $2; + my $supl = $3; + my $supn = $4; + if ( $infl eq $supl ) { + if ( $vl eq $infl and $vn >= $infn and $vn <= $supl ) { + return 1; + } + } + elsif ( $infl lt $supl ) { + if ( $vl eq $infl and $vn >= $infn ) { + return 1; + } + if ( $vl eq $supl and $vn <= $supn ) { + return 1; + } + if ( $vl gt $infl and $vl lt $supl ) { + return 1 + } + } + else { + alerte("FORMAT $champ \"$num2\" BIZARRE \"$val2\"") + } + } + } +elsif ( $val1 =~ /^([A-Za-z])(\d+)[-\x{2010}-\x{2015}\x{2212}]([A-Za-z])(\d+)\z/o ) { + my $infl = $1; + my $infn = $2; + my $supl = $3; + my $supn = $4; + if ( $val2 =~ /^([A-Za-z]+)(\d+)\z/o ) { + my $vl = $1; + my $vn = $2; + if ( $infl eq $supl ) { + if ( $vl eq $infl and $vn >= $infn and $vn <= $supl ) { + return 1; + } + } + elsif ( $infl lt $supl ) { + if ( $vl eq $infl and $vn >= $infn ) { + return 1; + } + if ( $vl eq $supl and $vn <= $supn ) { + return 1; + } + if ( $vl gt $infl and $vl lt $supl ) { + return 1 + } + } + else { + alerte("FORMAT $champ \"$num1\" BIZARRE \"$val1\"") + } + } + } +else { + alerte("FORMAT $champ \"$num1\" INATTENDU \"$val1\""); + if ( $val2 !~ /^\d+\z/o and + $val2 !~ /^([A-Za-z]+)(\d+)\z/o and + $val2 !~ /^(\d+)[-\x{2010}-\x{2015}\x{2212}](\d+)\z/o and + $val2 !~ /^([A-Za-z])(\d+)[-\x{2010}-\x{2015}\x{2212}]([A-Za-z])(\d+)\z/o ) { + alerte("FORMAT $champ \"$num2\" INATTENDU \"$val2\""); + } + } + +return 0; +} + +sub titre +{ +my ($t1, $t2, $sb) = @_; + +if ( $t1 eq $t2 or + lc($t1) eq lc($t2) or + lc(unidecode($t1)) eq lc(unidecode($t2))) { + return 1; + } + +$t2 =~ s|||go; + +my $tmp1 = lc(join(" ", ($t1 =~ /(\w+)/go))); +my $tmp2 = lc(join(" ", ($t2 =~ /(\w+)/go))); + +if ( $tmp1 eq $tmp2 ) { + return 1; + } +elsif ( unidecode($tmp1) eq unidecode($tmp2) ) { + return 1; + } +else { + $tmp1 = unidecode($tmp1); + $tmp2 = unidecode($tmp2); + my $ld = levenshtein_damereau($tmp1, $tmp2); + if ( $ld == 1 and length($tmp2) > 20 ) { + return 1; + } + elsif ( $ld == 2 and length($tmp2) > 40 ) { + return 1; + } + } + +if ( $sb ) { + if ( $tmp1 =~ /\b$tmp2\b/ or $tmp2 =~ /\b$tmp1\b/ ) { + return 0.5; + } + } + +if ( $t1 =~ /: /o or $t2 =~ /: /o ) { + my ($tmp1) = $t1 =~ /^(.+?)\s*: /o; + my ($tmp2) = $t2 =~ /^(.+?)\s*: /o; + if ( $tmp1 eq $tmp2 ) { + return 1; + } + else { + $tmp1 = lc(join(" ", ($tmp1 =~ /(\w+)/go))); + $tmp2 = lc(join(" ", ($tmp2 =~ /(\w+)/go))); + if ( $tmp1 eq $tmp2 ) { + return 1; + } + elsif ( unidecode($tmp1) eq unidecode($tmp2) ) { + return 1; + } + } + } + +## Test partie de titre +($tmp1 = $t1) =~ s/([^\w ])/\\$1/go; +($tmp2 = $t2) =~ s/([^\w ])/\\$1/go; +if ( length($t1) > length($t2) ) { + if ( $tmp1 =~ /^$tmp2\. .+/i ) { + return 0.5; + } + } +elsif ( length($t1) < length($t2) ) { + if ( $tmp2 =~ /^$tmp1\. .+/i ) { + return 0.5; + } + } + +return 0; +} + +sub levenshtein_damereau +{ +my ($s1, $s2) = @_; + +my $len1 = length $s1; +my $len2 = length $s2; + +return $len2 if $len1 == 0; +return $len1 if $len2 == 0; + +my %mat = (); + +for ( my $i = 0 ; $i <= $len1 ; $i ++ ) { + for ( my $j = 0 ; $j <= $len2 ; $j ++ ) { + $mat{$i}{$j} = 0; + $mat{0}{$j} = $j; + } + $mat{$i}{0} = $i; + } + +my @ar1 = split(//, $s1); +my @ar2 = split(//, $s2); + +my $cost = 0; + +for ( my $i = 1 ; $i <= $len1 ; $i ++ ) { + for ( my $j = 1 ; $j <= $len2 ; $j ++ ) { + $cost = $ar1[$i-1] eq $ar2[$j-1] ? 0 : 1; + $mat{$i}{$j} = min ([$mat{$i-1}{$j} + 1, + $mat{$i}{$j-1} + 1, + $mat{$i-1}{$j-1} + $cost]); + if ( $i > 1 and $j > 1 and + $ar1[$i - 1] eq $ar2[$j - 2] and + $ar1[$i - 2] eq $ar2[$j - 1] ) { + $mat{$i}{$j} = min ([$mat{$i}{$j}, $mat{$i-2}{$j-2} + $cost]); + } + } + } + +return $mat{$len1}{$len2}; +} + +sub min +{ +my @liste = @{$_[0]}; +my $min = shift @liste; + +foreach my $i (@liste) { + $min = $i if $i < $min; + } + +return $min; +} + +sub alerte +{ +my $message = shift; + +print LOG "ALERTE : $message\n"; +} + +__DATA__ + +## +## Liste d’entités caractères +## + +## +## NE PAS MODIFIER ! +## +## DO NOT EDIT! +## + +33 excl +34 dquot +35 num +36 dollar +37 percnt +40 lpar +41 rpar +42 ast +43 plus +44 comma +45 hyphen +46 period +47 sol +58 colon +59 semi +61 equals +63 quest +64 commat +91 lsqb +92 bsol +93 rsqb +95 lowbar +96 grave +123 lcub +124 verbar +256 Amacr; +257 amacr; +258 Abreve; +259 abreve; +260 Aogon; +261 aogon; +262 Cacute; +263 cacute; +264 Ccirc; +265 ccirc; +266 Cdot; +267 cdot; +268 Ccaron; +269 ccaron; +270 Dcaron; +271 dcaron; +272 Dstrok; +273 dstrok; +274 Emacr; +275 emacr; +278 Edot; +279 edot; +280 Eogon; +281 eogon; +282 Ecaron; +283 ecaron; +284 Gcirc; +285 gcirc; +286 Gbreve; +287 gbreve; +288 Gdot; +289 gdot; +290 Gcedil; +291 gcedil; +292 Hcirc; +293 hcirc; +294 Hstrok; +295 hstrok; +296 Itilde; +297 itilde; +298 Imacr; +299 imacr; +302 Iogon; +303 iogon; +304 Idot; +305 inodot; +306 IJlig; +307 ijlig; +308 Jcirc; +309 jcirc; +310 Kcedil; +311 kcedil; +312 kgreen; +313 Lacute; +314 lacute; +315 Lcedil; +316 lcedil; +317 Lcaron; +318 lcaron; +319 Lmidot; +320 lmidot; +321 Lstrok; +322 lstrok; +323 Nacute; +324 nacute; +325 Ncedil; +326 ncedil; +327 Ncaron; +328 ncaron; +329 napos; +330 ENG; +331 eng; +332 Omacr; +333 omacr; +336 Odblac; +337 odblac; +340 Racute; +341 racute; +342 Rcedil; +343 rcedil; +344 Rcaron; +345 rcaron; +346 Sacute; +347 sacute; +348 Scirc; +349 scirc; +350 Scedil; +351 scedil; +354 Tcedil; +355 tcedil; +356 Tcaron; +357 tcaron; +358 Tstrok; +359 tstrok; +360 Utilde; +361 utilde; +362 Umacr; +363 umacr; +364 Ubreve; +365 ubreve; +366 Uring; +367 uring; +368 Udblac; +369 udblac; +370 Uogon; +371 uogon; +372 Wcirc; +373 wcirc; +374 Ycirc; +375 ycirc; +377 Zacute; +378 zacute; +379 Zdot; +380 zdot; +381 Zcaron; +382 zcaron; +501 gacute; +711 caron; +728 breve; +729 dot; +730 ring; +731 ogon; +733 dblac; +902 Aacgr; +904 Eacgr; +905 EEacgr; +906 Iacgr; +908 Oacgr; +910 Uacgr; +911 OHacgr; +912 idiagr; +913 Agr; +914 Bgr; +915 Ggr; +916 Dgr; +917 Egr; +918 Zgr; +919 EEgr; +920 THgr; +921 Igr; +922 Kgr; +923 Lgr; +924 Mgr; +925 Ngr; +926 Xgr; +927 Ogr; +928 Pgr; +929 Rgr; +931 Sgr; +932 Tgr; +933 Ugr; +934 PHgr; +935 KHgr; +936 PSgr; +937 OHgr; +938 Idigr; +939 Udigr; +940 aacgr; +941 eacgr; +942 eeacgr; +943 iacgr; +944 udiagr; +945 agr; +946 bgr; +947 ggr; +948 dgr; +949 egr; +950 zgr; +951 eegr; +952 thgr; +953 igr; +954 kgr; +955 lgr; +956 mgr; +957 ngr; +958 xgr; +959 ogr; +960 pgr; +961 rgr; +962 sfgr; +963 sgr; +964 tgr; +965 ugr; +966 phgr; +967 khgr; +968 psgr; +969 ohgr; +970 idigr; +971 udigr; +972 oacgr; +973 uacgr; +974 ohacgr; +977 thetav; +981 phiv; +988 gammad; +1008 kappav; +1009 rhov; +1025 IOcy; +1026 DJcy; +1027 GJcy; +1028 Jukcy; +1029 DScy; +1030 Iukcy; +1031 YIcy; +1032 Jsercy; +1033 LJcy; +1034 NJcy; +1035 TSHcy; +1036 KJcy; +1038 Ubrcy; +1039 DZcy; +1040 Acy; +1041 Bcy; +1042 Vcy; +1043 Gcy; +1044 Dcy; +1045 IEcy; +1046 ZHcy; +1047 Zcy; +1048 Icy; +1049 Jcy; +1050 Kcy; +1051 Lcy; +1052 Mcy; +1053 Ncy; +1054 Ocy; +1055 Pcy; +1056 Rcy; +1057 Scy; +1058 Tcy; +1059 Ucy; +1060 Fcy; +1061 KHcy; +1062 TScy; +1063 CHcy; +1064 SHcy; +1065 SHCHcy; +1066 HARDcy; +1067 Ycy; +1068 SOFTcy; +1069 Ecy; +1070 YUcy; +1071 YAcy; +1072 acy; +1073 bcy; +1074 vcy; +1075 gcy; +1076 dcy; +1077 iecy; +1078 zhcy; +1079 zcy; +1080 icy; +1081 jcy; +1082 kcy; +1083 lcy; +1084 mcy; +1085 ncy; +1086 ocy; +1087 pcy; +1088 rcy; +1089 scy; +1090 tcy; +1091 ucy; +1092 fcy; +1093 khcy; +1094 tscy; +1095 chcy; +1096 shcy; +1097 shchcy; +1098 hardcy; +1099 ycy; +1100 softcy; +1101 ecy; +1102 yucy; +1103 yacy; +1105 iocy; +1106 djcy; +1107 gjcy; +1108 jukcy; +1109 dscy; +1110 iukcy; +1111 yicy; +1112 jsercy; +1113 ljcy; +1114 njcy; +1115 tshcy; +1116 kjcy; +1118 ubrcy; +1119 dzcy; +8196 emsp13; +8197 emsp14; +8199 numsp; +8200 puncsp; +8202 hairsp; +8208 dash; +8211 ndash; +8212 mdash; +8213 horbar; +8214 Verbar; +8229 nldr; +8244 tprime; +8245 bprime; +8257 caret; +8259 hybull; +8411 tdot; +8412 DotDot; +8453 incare; +8459 hamilt; +8463 planck; +8466 lagran; +8467 ell; +8470 numero; +8471 copysr; +8478 rx; +8486 ohm; +8491 angst; +8492 bernou; +8499 phmmat; +8500 order; +8502 beth; +8503 gimel; +8504 daleth; +8531 frac13; +8532 frac23; +8533 frac15; +8534 frac25; +8535 frac35; +8536 frac45; +8537 frac16; +8538 frac56; +8539 frac18; +8540 frac38; +8541 frac58; +8542 frac78; +8597 varr; +8598 nwarr; +8599 nearr; +8600 drarr; +8601 dlarr; +8602 nlarr; +8603 nrarr; +8605 rarrw; +8606 Larr; +8608 Rarr; +8610 larrtl; +8611 rarrtl; +8614 map; +8617 larrhk; +8618 rarrhk; +8619 larrlp; +8620 rarrlp; +8621 harrw; +8622 nharr; +8624 lsh; +8625 rsh; +8630 cularr; +8631 curarr; +8634 olarr; +8635 orarr; +8636 lharu; +8637 lhard; +8638 uharr; +8639 uharl; +8640 rharu; +8641 rhard; +8642 dharr; +8643 dharl; +8644 rlarr2; +8646 lrarr2; +8647 larr2; +8648 uarr2; +8649 rarr2; +8650 darr2; +8651 lrhar2; +8652 rlhar2; +8653 nlArr; +8654 nhArr; +8655 nrArr; +8661 vArr; +8666 lAarr; +8667 rAarr; +8705 comp; +8708 nexist; +8714 epsis; +8717 bepsi; +8720 coprod; +8722 minus; +8723 mnplus; +8724 plusdo; +8726 setmn; +8728 compfn; +8735 ang90; +8737 angmsd; +8738 angsph; +8739 mid; +8740 nmid; +8741 par; +8742 npar; +8750 conint; +8757 becaus; +8765 bsim; +8768 wreath; +8769 nsim; +8771 sime; +8772 nsime; +8775 ncong; +8777 nap; +8778 ape; +8780 bcong; +8782 bump; +8783 bumpe; +8784 esdot; +8785 eDot; +8786 efDot; +8787 erDot; +8788 colone; +8789 ecolon; +8790 ecir; +8791 cire; +8793 wedgeq; +8796 trie; +8802 nequiv; +8806 lE; +8807 gE; +8808 lne; +8809 gne; +8810 Lt; +8811 Gt; +8812 twixt; +8814 nlt; +8815 ngt; +8816 nle; +8817 nge; +8818 lsim; +8819 gsim; +8822 lg; +8823 gl; +8826 pr; +8827 sc; +8828 pre; +8829 sce; +8830 prsim; +8831 scsim; +8832 npr; +8833 nsc; +8837 nsup; +8840 nsube; +8841 nsupe; +8842 subne; +8843 supne; +8846 uplus; +8847 sqsub; +8848 sqsup; +8849 sqsube; +8850 sqsupe; +8851 sqcap; +8852 sqcup; +8854 ominus; +8856 osol; +8857 odot; +8858 ocir; +8859 oast; +8861 odash; +8862 plusb; +8863 minusb; +8864 timesb; +8865 sdotb; +8866 vdash; +8867 dashv; +8868 top; +8871 models; +8872 vDash; +8873 Vdash; +8874 Vvdash; +8876 nvdash; +8877 nvDash; +8878 nVdash; +8879 nVDash; +8882 vltri; +8883 vrtri; +8884 ltrie; +8885 rtrie; +8888 mumap; +8890 intcal; +8891 veebar; +8892 barwed; +8900 diam; +8902 sstarf; +8903 divonx; +8904 bowtie; +8905 ltimes; +8906 rtimes; +8907 lthree; +8908 rthree; +8909 bsime; +8910 cuvee; +8911 cuwed; +8912 Sub; +8913 Sup; +8914 Cap; +8915 Cup; +8916 fork; +8918 ldot; +8919 gsdot; +8920 Ll; +8921 Gg; +8922 leg; +8923 gel; +8924 els; +8925 egs; +8926 cuepr; +8927 cuesc; +8928 npre; +8929 nsce; +8934 lnsim; +8935 gnsim; +8936 prnsim; +8937 scnsim; +8938 nltri; +8939 nrtri; +8940 nltrie; +8941 nrtrie; +8942 vellip; +8966 Barwed; +8972 drcrop; +8973 dlcrop; +8974 urcrop; +8975 ulcrop; +8981 telrec; +8982 target; +8988 ulcorn; +8989 urcorn; +8990 dlcorn; +8991 drcorn; +8994 frown; +8995 smile; +9251 blank; +9416 oS; +9472 boxh; +9474 boxv; +9484 boxdr; +9488 boxdl; +9492 boxur; +9496 boxul; +9500 boxvr; +9508 boxvl; +9516 boxhd; +9524 boxhu; +9532 boxvh; +9552 boxH; +9553 boxV; +9554 boxdR; +9555 boxDr; +9556 boxDR; +9557 boxdL; +9558 boxDl; +9559 boxDL; +9560 boxuR; +9561 boxUr; +9562 boxUR; +9563 boxuL; +9564 boxUl; +9565 boxUL; +9566 boxvR; +9567 boxVr; +9568 boxVR; +9569 boxvL; +9570 boxVl; +9571 boxVL; +9572 boxHd; +9573 boxhD; +9574 boxHD; +9575 boxHu; +9576 boxhU; +9577 boxHU; +9578 boxvH; +9579 boxVh; +9580 boxVH; +9600 uhblk; +9604 lhblk; +9608 block; +9617 blk14; +9618 blk12; +9619 blk34; +9633 squ; +9642 squf; +9645 rect; +9646 marker; +9651 xutri; +9652 utrif; +9653 utri; +9656 rtrif; +9657 rtri; +9661 xdtri; +9662 dtrif; +9663 dtri; +9666 ltrif; +9667 ltri; +9675 cir; +9733 starf; +9734 star; +9742 phone; +9792 female; +9794 male; +9834 sung; +9837 flat; +9838 natur; +9839 sharp; +10003 check; +10007 cross; +10016 malt; +10022 lozf; +10038 sext; +64256 fflig; +64257 filig; +64258 fllig; +64259 ffilig; + +## +## The End! +## diff --git a/04-generation_tei/README.md b/04-generation_tei/README.md new file mode 100644 index 0000000..0b649ce --- /dev/null +++ b/04-generation_tei/README.md @@ -0,0 +1,113 @@ +Génération de fichiers d’enrichissement TEI +=============== + +Programme de génération de fichiers au format TEI pour la base Istex. + +Le programme `alignment2tei.pl` permet, à partir des résultats dédoublonnés de l’alignement Pascal/Francis - Istex, de générer un fichier d’enrichissement au format TEI. Les fichiers ainsi générés peuvent être placés directement dans un système de répertoires à 4 niveaux pour pouvoir intégrer la base **Istex**. + + +### Usage + +```txt + alignment2tei.pl -f (fichier|-) -a fichier_align -d date -v version [ -l log ] + [ -c répertoire_cc ] [ -r (0|1) ] [ -x ] + alignment2tei.pl -h fichier_HFD -a fichier_align -d date -v version [ -l log ] + [ -c répertoire_cc ] [ -r (0|1) ] [ -x ] + alignment2tei.pl -i +``` + +### Options + +```txt + -a indique le nom du fichier résultat de l’alignement (qui peut être un + fichier compressé avec “gzip” ou “bzip2”) + -c indique le nom du répertoire contenant les tables de correspondance + entre codes de classement Pascal ou Francis et verbalisation (“CC” par + défaut) + -d indique la date à laquelle a été fait l’alignement, en utilisant le format + “aaaa-mm-jj” (par ex. “2020-09-28”) + -f indique le nom du fichier de notices Pascal/Francis (qui peut être un + fichier compressé avec “gzip” ou “bzip2”). Pour utiliser l’entrée standard, + mettre un tiret “-” comme argument + -h indique le nom du fichier HFD de notices Pascal/Francis servant d’entrée + au programme + -i affiche cette aide + -l indique le nom du fichier “log” recevant la liste des notices INIST + appariées ainsi que les identifiants des documents ISTEX correspondants + -r crée l'organisation hiérarchique en 4 répertoires d’ISTEX si la valeur + est 1 (valeur par défaut). Autrement, les fichiers sont créés dans le + répertoire courant + -v indique le numéro de version du programme “matchStan2Istex.pl” utilisé + pour réaliser l’alignement + -x accepte comme valides les appariements lorsque la valeur du score est + suivie d’un point d’exclamation (“!”) +``` + + +### Description + +Le programme lit le fichier de résultat de l'alignement, après correction (si nécessaire) et dédoublonnage, établit la liste des notices **Inist** et documents **Istex** appariés et, à partir des informations extraites des notices **Inist**, génère pour chaque document **Istex** un fichier XML au format TEI contenant des données identifiant la notice bibliographique et le document lui-même, ainsi que les codes de classement, avec leur verbalisation en français et en anglais pour chaque niveau hiérarchique du code en question, comme dans l’exemple suivant avec le code `001B30B80P` : + +```xml + + + Physique + + + Physique atomique et moléculaire + + + Propriétés atomiques et interactions avec les photons + + + Interactions des photons avec les atomes + + + Refroidissement optique d'atomes; piégeage + + +``` + +On y trouve aussi les mots-clés extraits de la notice bibliographique, également en français et en anglais, avec pour certains descripteurs leur nature ou fonction, ou leur statut dans la base (i.e. candidat descripteur ou terme libre), comme dans l’exemple suivant : + +```xml + + Lithium + + + + + + Cation + + + + + Constante Rydberg + + + Spectrométrie microonde + + + + + + Candidat descripteur + + + +``` + +Pour verbaliser les codes de classement, le programme utilise plusieurs tables de correspondance, par défaut présentes dans le répertoire `CC` ou dans le répertoire défini par l’option `-c`. Ces tables contiennent : + + - la verbalisation en français et en anglais des différents codes Pascal ou Francis : + - `verbFrancisEn.txt` + - `verbFrancisFr.txt` + - `verbPascalEn.txt` + - `verbPascalFr.txt` + - les équivalences entre codes pour avoir une verbalisation unique quelle que soit la date de production de la notice : + - `equivCCFrancis.txt` + - `equivCCPascal.txt` + - la liste des liens vers l’application Lodex définissant les domaines scientifiques : + - `liensLodex.txt` + diff --git a/04-generation_tei/alignment2tei.pl b/04-generation_tei/alignment2tei.pl new file mode 100755 index 0000000..87b285c --- /dev/null +++ b/04-generation_tei/alignment2tei.pl @@ -0,0 +1,2027 @@ +#!/usr/bin/perl + + +# Déclaration des pragmas +use strict; +use utf8; +use open qw/:std :utf8/; + +# Appel des modules externes de base +use Encode; +use Getopt::Long; + +# Appel des modules spécifiques à l'application +use HTML::Entities qw(decode_entities %entity2char); +## use HTTP::CookieJar::LWP; +use JSON; +## use LWP::UserAgent; +use Text::Unidecode; +## use URI::Encode qw(uri_encode uri_decode); + +my ($programme) = $0 =~ m|^(?:.*/)?(.+)|; +my $substitut = " " x (length($programme) - 2); +my $Version = "1.9.2"; +my $dateModif = "7 Mars 2021"; + +my $usage = "Usage : \n" . + " $programme -f (fichier|-) -a fichier_align -d date -v version [ -l log ] \n" . + " $substitut [ -c répertoire_cc ] [ -r (0|1) ] [ -x ] \n" . + " $programme -h fichier_HFD -a fichier_align -d date -v version [ -l log ] \n" . + " $substitut [ -c répertoire_cc ] [ -r (0|1) ] [ -x ] \n" . + " $programme -i \n"; +$substitut .= " "; + +my $align = undef; +my $cc_dir = "CC"; +my $date = undef; +my $fichier = undef; +my $hfd = undef; +my $info = undef; +my $log = undef; +my $ready = 1; +my $version = undef; +my $xclam = 0; + +eval { + $SIG{__WARN__} = sub {usage(1);}; + GetOptions( + "align=s" => \$align, + "cc_dir=s" => \$cc_dir, + "date=s" => \$date, + "fichier=s" => \$fichier, + "hfd=s" => \$hfd, + "info" => \$info, + "log=s" => \$log, + "ready=i" => \$ready, + "version=s" => \$version, + "xclam" => \$xclam, + ); + }; +$SIG{__WARN__} = sub {warn $_[0];}; + +if ( $info ) { + print " \n"; + print "Programme : \n"; + print " “$programme”, version $Version ($dateModif)\n"; + print " Permet de créer les fichiers d’enrichissement avec les codes de classement \n"; + print " et les mots-clés Pascal ou Francis au format TEI StandOff \n"; + print "\n"; + print $usage; + print "\nOptions : \n"; + print " -a indique le nom du fichier résultat de l’alignement (qui peut être un \n"; + print " fichier compressé avec “gzip” ou “bzip2”) \n"; + print " -c indique le nom du répertoire contenant les tables de correspondance \n"; + print " entre codes et verbalisation \n"; + print " -d indique la date à laquelle a été fait l’alignement, en utilisant le format \n"; + print " “aaaa-mm-jj” (par ex. “2020-09-28”) \n"; + print " -f indique le nom du fichier d’entrée (qui peut être un fichier compressé \n"; + print " avec “gzip” ou “bzip2”). Pour utiliser l’entrée standard, mettre un \n"; + print " tiret “-” comme argument \n"; + print " -h indique le nom du fichier HFD servant d’entrée au programme \n"; + print " -i affiche cette aide \n"; + print " -l indique le nom du fichier “log” contenant la liste des notices INIST \n"; + print " appariées ainsi que les identifiants des documents ISTEX correspondants \n"; + print " -r crée l'organisation hiérarchique en 4 répertoires d’ISTEX si la valeur \n"; + print " est 1 (valeur par défaut). Autrement, les fichiers sont créés dans le \n"; + print " répertoire courant \n"; + print " -v indique le numéro de version du programme “matchStan2Istex.pl” utilisé \n"; + print " pour réaliser l’alignement \n"; + print " -x accepte comme valides les appariements lorsque la valeur du score est \n"; + print " suivie d’un point d’exclamation (“!”) \n"; + print " \n"; + + exit 0; + } + +usage(2) if not $align or not $date or not $version; +usage(2) if not $fichier and not $hfd; +usage(2) if $fichier and $hfd; + +if ( $date !~ /^(\d\d\d\d)-(\d\d)-(\d\d)\z/ ) { + print STDERR "\n"; + print STDERR "$programme : erreur dans le format de la date ! \n"; + print STDERR "$substitut Utilisez le format “aaaa-mm-jj”. \n"; + exit 3; + } + +if ( $version !~ /^\d+\.\d+\.\d+\z/ ) { + print STDERR "\n"; + print STDERR "$programme : erreur dans le format de la version ! \n\n"; + print STDERR "Vérifiez la bonne version avec la commande : “matchStan2Istex.pl -i” \n"; + exit 4; + } + +if ( $cc_dir =~ m|^(.*)/\z| ) { + $cc_dir = $1; + } + +# Variables +my $annee = ""; +my $inist = ""; +my $num = 0; +my @matchs = (); +my @parties = (); +my %base = (); +my %canon = (); +my %classe = (); +my %equiv = (); +my %francis = (); +my %lodex = (); +my %match = (); +my %verb = (); + +# Tables nécessaires aux verbalisation +my $verbPascalFr = "$cc_dir/verbPascalFr.txt"; +my $verbPascalEn = "$cc_dir/verbPascalEn.txt"; +my $verbFrancisFr = "$cc_dir/verbFrancisFr.txt"; +my $verbFrancisEn = "$cc_dir/verbFrancisEn.txt"; +my $equivCCPascal = "$cc_dir/equivCCPascal.txt"; +my $equivCCFrancis = "$cc_dir/equivCCFrancis.txt"; +my $liensLodex = "$cc_dir/liensLodex.txt"; + +# Lecture des tables +open(VPF, "<:utf8", $verbPascalFr) or die "$!,"; +while() { + chomp; + s/\r//go; + my ($code, $intitule) = split(/\t/); + $verb{$code}{'FR'} = $intitule; + } +close VPF; + +open(VPE, "<:utf8", $verbPascalEn) or die "$!,"; +while() { + chomp; + s/\r//go; + my ($code, $intitule) = split(/\t/); + $verb{$code}{'EN'} = $intitule; + } +close VPE; + +open(VFF, "<:utf8", $verbFrancisFr) or die "$!,"; +while() { + chomp; + s/\r//go; + my ($code, $intitule) = split(/\t/); + $verb{$code}{'FR'} = $intitule; + if ( $code =~ /^[567]\d\d\z/o ) { + $francis{$code} ++; + } + } +close VFF; + +open(VFE, "<:utf8", $verbFrancisEn) or die "$!,"; +while() { + chomp; + s/\r//go; + my ($code, $intitule) = split(/\t/); + $verb{$code}{'EN'} = $intitule; + } +close VFE; + +open(EQP, "<:utf8", $equivCCPascal) or die "$!,"; +while() { + chomp; + s/\r//go; + my ($ac, $canon) = split(/\t/); + my ($an, $code) = split(/-/, $ac); + $equiv{'Pascal'}{$an}{$code} = $canon; + $canon{'Pascal'}{$code}{$canon} ++; + } +close EQP; + +open(EQF, "<:utf8", $equivCCFrancis) or die "$!,"; +while() { + chomp; + s/\r//go; + my ($ca, $canon) = split(/\t/); + if ( $canon =~ /^-(.+)/ ) { + $canon = $1; + } +# if ( $canon =~ /^(.+?)-(.+)/o ) { +# $canon = $1.$2; +# } + if ( $canon =~ /^(.+?) (.+)/o ) { + $canon = "$1-$2"; + } + my ($code, $an) = split(/#/, $ca); +# if ( $code =~ /^(.+?)-(.+)/o ) { +# $code = $1.$2; +# } + if ( $code =~ /^(.+?) (.+)/o ) { + $code = "$1-$2"; + } + $equiv{'Francis'}{$an}{$code} = $canon; + } +close EQF; + +open(LDX, "<:utf8", $liensLodex) or die "$!,"; +while() { + chomp; + s/\r//go; + my ($lien, $code, $intitule) = split(/\t/); + $lodex{$code} = $lien; + } +close LDX; + +# Lecture du modèle de fichier +while() { + next if /^\s*$/o; + next if /^#/o; + if ( /^%%\s+partie\s+(\d+)/o ) { + $num = $1; + } + elsif ( /^%%\s+FIN/o ) { + last; + } + else { + $parties[$num] .= $_; + } + } + +# Modification de la date et du numéro de version +$parties[3] =~ s/%DATE%/$date/; +$parties[3] =~ s/%VERSION%/$version/; + +# Complétion de la table des entitées HTML +#foreach my $item (qw/amp gt lt/) { +# delete $entity2char{$item}; +# } +while() { + next if /^\s*$/o; + next if /^#/o; + chomp; + my ($num, $sgml) = split(/\t+/); + next if $entity2char{$sgml}; + $entity2char{$sgml} = chr($num); + } +close DATA; + +my %trans = ( + "205" => 1, + "210" => 1, + "215" => 1, + "220" => 1, + "221" => 1, + "222" => 1, + "223" => 1, + "224" => 1, + "225" => 1, + "226" => 1, + "227" => 1, + "230" => 1, + "235" => 1, + "240" => 1, + "250" => 1, + "260" => 1, + "280" => 1, + "295" => 1, + ); + +my %voc = ( + "2" => "Sciences de la Terre", + "9" => "Traductions", + "X" => "Sciences exactes, Sciences de la vie, Technologies", + "A" => "Art et archéologie", + "B" => "Science administrative", + "C" => "Sciences de l’éducation", + "D" => "Gestion des entreprises", + "E" => "Économie de l’énergie", + "G" => "Bibliographie géographique internationale", + "H" => "Préhistoire et protohistoire", + "I" => "Histoire et sciences de la littérature", + "J" => "Informatique et sciences juridiques", + "L" => "Sciences du langage", + "N" => "Éthnologie", + "P" => "Philosophie", + "R" => "Histoire et sciences des religions", + "S" => "Sociologie", + "T" => "Histoire des sciences et techniques", + "U" => "Amérique latine", + "V" => "Sciences humaines de la santé", + "W" => "Économie générale", + "1" => "Sciences de l’ingénieur", + "3" => "Physique", + ); +my %nfe = ( + "agr" => "Agrovoc descriptor", + "ar" => "Architect", + "cog" => "Geographical coordinate", + "da" => "Anion", + "dc" => "Cation", + "de" => "Enzyme", + "dg" => "Geography", + "dp" => "Psychometrics", + "ds" => "Systematics", + "dw" => "Virus", + "fa" => "Author", + "fc" => "Organic ligand", + "fd" => "Chronology", + "fe" => "Enzyme", + "ff" => "Pesticide", + "fm" => "Methodology", + "fr" => "Medicament", + "fs" => "Site", + "fx" => "Toxic", + "na" => "Anion", + "nb" => "Cited work", + "nc" => "Cation", + "nd" => "Date", + "ne" => "Technique", + "nf" => "Person (human being, divinity)", + "ng" => "Geography", + "ni" => "Matter-Concept", + "nj" => "Organization-Institution", + "nk" => "Chemical compound", + "nl" => "Language", + "nm" => "Disease", + "nn" => "Ethnic group", + "no" => "Celestial body", + "np" => "Psychometric test", + "ns" => "Systematics", + "nt" => "Soil", + "nv" => "Petrography", + "nw" => "Virus", + "nx" => "Stratigraphy", + "ny" => "Paleontology", + "nz" => "Mineralogy", + "sa" => "Works (buildings)", + "si" => "Information system", + "tec" => "Commercial name. Technical name", + "vf" => "Pesticides", + "vk" => "Chemical terms", + "vr" => "Medicaments", + "vx" => "Toxics", + "CD" => "Candidate keyword", + "INC" => "Uncontrolled term", + ); +my %nff = ( + "agr" => "Descripteur Agrovoc", + "ar" => "Architecte", + "cog" => "Coordonnée géographique", + "da" => "Anion", + "dc" => "Cation", + "de" => "Enzyme", + "dg" => "Géographie", + "dp" => "Psychométrie", + "ds" => "Systématique", + "dw" => "Virus", + "fa" => "Auteur", + "fc" => "Coordinat organique", + "fd" => "Chronologie", + "fe" => "Enzyme", + "ff" => "Pesticide", + "fm" => "Méthodologie", + "fr" => "Médicament", + "fs" => "Site", + "fx" => "Toxique", + "na" => "Anion", + "nb" => "Oeuvre citée", + "nc" => "Cation", + "nd" => "Date", + "ne" => "Technique", + "nf" => "Personne (être humain, divinité)", + "ng" => "Géographie", + "ni" => "Matière-Concept", + "nj" => "Organisme-Institution", + "nk" => "Composé chimique", + "nl" => "Langue", + "nm" => "Maladie", + "nn" => "Ethnie", + "no" => "Objet céleste", + "np" => "Test de psychométrie", + "ns" => "Systématique", + "nt" => "Sol", + "nv" => "Pétrographie", + "nw" => "Virus", + "nx" => "Stratigraphie", + "ny" => "Paléontologie", + "nz" => "Minéralogie", + "sa" => "Ouvrages (bâtiments)", + "si" => "Système d'information", + "tec" => "Nom commercial. Nom technique", + "vf" => "Pesticides", + "vk" => "Termes chimiques", + "vr" => "Médicaments", + "vx" => "Toxiques", + "CD" => "Candidat descripteur", + "INC" => "Terme non contrôlé", + ); + +if ( $align =~ /\.gz\z/o ) { + open(INP, "gzip -cd $align |") or die "$!,"; + binmode(INP, ":utf8"); + } +elsif ( $align =~ /\.bz2\z/o ) { + open(INP, "bzip2 -cd $align |") or die "$!,"; + binmode(INP, ":utf8"); + } +else { + open(INP, "<:utf8", $align) or die "$!,"; + } + +if ( $log ) { + open(LOG, ">:utf8", $log) or die "$!,"; + } +else { + open(LOG, ">:utf8", "/dev/null") or die "$!,"; + } + +while() { + if (/^([_.0\*\+]+\x{00A0}*)\t(\d\.\d+)(!?)\t/o) { + my $score = $1; + my $grade = $2; + my $statut = $3; + $statut = undef if not $xclam; + if ( $grade < 3.490 and not $statut ) { + $inist = undef; + next; + } + chomp; + my @champs = split(/\t/); + $inist = $champs[3]; + my $id = $champs[17]; + my $ark = $champs[18]; + my $doi = $champs[19]; + my $pii = $champs[20]; + my $pmid = $champs[21]; + print LOG "$inist\t$grade$statut\t$id\t$ark\t$doi\t$pii\t$pmid\n"; + push(@{$match{$inist}}, "$id\t$ark\t$doi\t$pii\t$pmid"); + } + elsif (/^([_.0\*\+]+\x{00A0}*)\t(\d\.\d+)\W\t/o) { + $inist = undef; + } + elsif ( /^ ~~> \t/o ) { + next if not $inist; + chomp; + my @champs = split(/\t/); + my $id = $champs[5]; + my $ark = $champs[6]; + my $doi = $champs[7]; + my $pii = $champs[8]; + my $pmid = $champs[9]; + print LOG "$inist\t \" \" \t$id\t$ark\t$doi\t$pii\t$pmid\n"; + push(@{$match{$inist}}, "$id\t$ark\t$doi\t$pii\t$pmid"); + } + } +close INP; + +if ( $fichier ) { + if ( $fichier =~ /\.gz\z/o ) { + open(INP, "gzip -cd $fichier |") or die "$!,"; + binmode(INP, ":raw"); + } + elsif ( $fichier =~ /\.bz2\z/o ) { + open(INP, "bzip2 -cd $fichier |") or die "$!,"; + binmode(INP, ":raw"); + } + else { + open(INP, "<:raw", $fichier) or die "$!,"; + } + } +elsif ( $hfd ) { + open(INP, "IhfdCat $hfd |") or die "$!,"; + binmode(INP, ":raw"); + } + +while() { +# ($inist) = m|((?:\d\d\d-)?\d\d-\d+)|o; + ($inist) = m|(.+?)|o; + next if not defined $match{$inist}; + + $annee = undef; + if ( $inist =~ /^(\d\d)-\d+\z/o ) { + $annee = $1; + } + elsif ( $inist =~ /^\d\d\d[-.](\d\d)[-.]\d+\z/o ) { + $annee = $1; + } + else { + print STDERR "N° INIST incorrect \"$inist\"\n"; + } + if ( $annee > 50 ) { + $annee = "19$annee"; + } + else { + $annee = "20$annee"; + } + + my @codes = (); + foreach my $item (m|(.+?)|go) { + if ( $item =~ m|(([567]\d\d)(.*?))(.+?)|o ) { + my $pos = $1; + my $base = $2; + my $code = $3; + if ( $5 ) { + $code = "$4-$5"; + } + elsif ( $codes[$#codes] =~ /^$code/ ) { + next; + } + $codes[$pos] = "$base:$code"; + $base{$code} = "$4"; + $classe{$code} = "$4-$6"; + } + elsif ( $item =~ m|(.+?)|o ) { + my $pos = $1; + my $base = $2; + my $code = $3; + if ( $code =~ /^([567]\d\d)(\w+)\z/o ) { + $code = "$1-$2" if $francis{$1}; + } + elsif ( $code =~ /^(2\d\d)\w*\z/o ) { + next if $trans{$1}; + } + else { + if ( $code =~ /^001B40F30A[12]\z/o ) { + $code .= "0"; + } + elsif ( $code =~ /^002B31\w+\z/o ) { + $code = "002B31"; + } + } + $codes[$pos] = "$base:$code"; + } + elsif ( $item =~ m|(.+?)|o ) { +# my $pos = $1; +# my $base = $2; + my $code = $3; + if ( $code =~ /^[IVXL]+\z/o ) { + if ( $codes[$#codes] =~ /^\w:(([567]\d\d)-?\w+)\z/o ) { + $classe{$1} = "$2-$code"; + } + } + } + } + my %specifiques = (); + my %generiques = (); + foreach my $item (m|(.+?)|go) { + my $langue = ""; + my $numero = ""; + my $ig2 = ""; + my $motcle = ""; + my $type = ""; + my @nf = (); + if ( $item =~ m||o ) { + $langue = $3; + $numero = $1; + $ig2 = $2; + } + if ( $item =~ m|(.+?)|o ) { + $motcle = decode_entities($1); + $motcle =~ s/^\s+//o; + $motcle =~ s/\s+\z//o; + $motcle =~ s/\s\s+/ /go; + } + if ( $item =~ m|.+?|o ) { + next if $item =~ m|PAC|o; + my %tmp = (); + foreach my $nf ($item =~ m|(.+?)|go) { + next if $tmp{$nf} ++; + push(@nf, $nf); + } + } + if ( $item =~ m#(CD|INC)#io ) { + $type = $1; + } + $specifiques{$langue}{$numero}{$motcle}{'voc'} = $ig2; + if ( @nf ) { + push(@{$specifiques{$langue}{$numero}{$motcle}{'nf'}}, @nf); + } + if ( $type ) { + $specifiques{$langue}{$numero}{$motcle}{'type'} = $type; + } + } + foreach my $item (m|(.+?)|go) { + my $langue = ""; + my $numero = ""; + my $ig2 = ""; + my $motcle = ""; + my $type = ""; + my @nf = (); + if ( $item =~ m||o ) { + $langue = $3; + $numero = $1; + $ig2 = $2; + } + if ( $item =~ m|(.+?)|o ) { + $motcle = decode_entities($1); + $motcle =~ s/^\s+//o; + $motcle =~ s/\s+\z//o; + $motcle =~ s/\s\s+/ /go; + } + if ( $item =~ m|.+?|o ) { + my %tmp = (); + foreach my $nf ($item =~ m|(.+?)|go) { + next if $tmp{$nf} ++; + push(@nf, $nf); + } + } + if ( $item =~ m#(CD|INC)#io ) { + $type = $1; + } + $generiques{$langue}{$numero}{$motcle}{'voc'} = $ig2; + if ( @nf ) { + push(@{$generiques{$langue}{$numero}{$motcle}{'nf'}}, @nf); + } + if ( $type ) { + $generiques{$langue}{$numero}{$motcle}{'type'} = $type; + } + } + foreach my $istex (@{$match{$inist}}) { + my ($id, $ark, $doi, $pii, $pmid) = split(/\t/, $istex); + if ( $ready ) { + my $chemin = substr($id, 0, 1); + if ( not -d $chemin ) { + mkdir($chemin, 0755) or die "$!,"; + } + $chemin .= "/" . substr($id, 1, 1); + if ( not -d $chemin ) { + mkdir($chemin, 0755) or die "$!,"; + } + $chemin .= "/" . substr($id, 2, 1); + if ( not -d $chemin ) { + mkdir($chemin, 0755) or die "$!,"; + } + $chemin .= "/$id"; + if ( not -d $chemin ) { + mkdir($chemin, 0755) or die "$!,"; + } + open(TEI, ">:utf8", "$chemin/${id}_ipf.tei") or die "$!,"; + } + else { + open(TEI, ">:utf8", "${id}_ipf.tei") or die "$!,"; + } + print TEI $parties[1]; + my $marge = 24; + print TEI " " x $marge, "$id\n"; + print TEI " " x $marge, "$ark\n"; + print TEI " " x $marge, "$inist\n"; + if ( $doi ) { + print TEI " " x $marge, "$doi\n"; + } + if ( $pii ) { + print TEI " " x $marge, "$pii\n"; + } + if ( $pmid ) { + print TEI " " x $marge, "$pmid\n"; + } + print TEI $parties[3]; + if ( @codes ) { + my @tmp = grep(/:00[12]/o, @codes); + if ( @tmp ) { + @codes = @tmp; + } + (my $tmp = $parties[4]) =~ s/%YEAR%/$annee/; + print TEI $tmp; + my @lignes = codes('FR', @codes); + print TEI @lignes; + print TEI $parties[6]; + ($tmp = $parties[7]) =~ s/%YEAR%/$annee/; + print TEI $tmp; + @lignes = codes('EN', @codes); + print TEI @lignes; + print TEI $parties[9] + # En l’absence de verbalisations espagnoles, + # on ne fait pas (pour l’instant) les parties + # 10 à 12 + } + if ( defined $specifiques{'FRE'} or defined $generiques{'FRE'} ) { + my @lignes = (); + print TEI $parties[13]; + if ( defined $specifiques{'FRE'} ) { + @lignes = motscles('FRE', %specifiques); + print TEI @lignes; + } + if ( defined $generiques{'FRE'} ) { + @lignes = motscles('FRE', %generiques); + print TEI @lignes; + } + print TEI $parties[15] + } + if ( defined $specifiques{'ENG'} or defined $generiques{'ENG'} ) { + my @lignes = (); + print TEI $parties[16]; + if ( defined $specifiques{'ENG'} ) { + @lignes = motscles('ENG', %specifiques); + print TEI @lignes; + } + if ( defined $generiques{'ENG'} ) { + @lignes = motscles('ENG', %generiques); + print TEI @lignes; + } + print TEI $parties[18] + } + if ( defined $specifiques{'SPA'} or defined $generiques{'SPA'} ) { + my @lignes = (); + print TEI $parties[19]; + if ( defined $specifiques{'SPA'} ) { + @lignes = motscles('SPA', %specifiques); + print TEI @lignes; + } + if ( defined $generiques{'SPA'} ) { + @lignes = motscles('SPA', %generiques); + print TEI @lignes; + } + print TEI $parties[21] + } + print TEI $parties[22]; + close TEI; + } + } +close INP; + + +exit 0; + + +sub usage +{ +print STDERR "\n$usage\n"; + +exit shift; +} + +sub niveaux +{ +my $code = shift; + +my @niveaux = (); +$niveaux[0] = 0; + +if ( $code =~ /^2\d\d/o ) { + if ( $code =~ /^(((2\d\d)[A-Z])\d\d)/o ) { + $niveaux[1] = $3; + $niveaux[2] = $2; + $niveaux[3] = $1; + $niveaux[0] = 3; + } + elsif ( $code =~ /^((2\d\d)[A-Z])/o ) { + $niveaux[1] = $2; + $niveaux[2] = $1; + $niveaux[0] = 2; + } + elsif ( $code =~ /^(2\d\d)/o ) { + $niveaux[1] = $1; + $niveaux[0] = 1; + } + } +elsif ( $code =~ /^00[12][A-Z]/o ) { + if ( $code =~ /^(((((((00[12][A-Z])\d\d)[A-Z])\d\d)[A-Z])\d)[A-Z])/o ) { + $niveaux[1] = $7; + $niveaux[2] = $6; + $niveaux[3] = $5; + $niveaux[4] = $4; + $niveaux[5] = $3; + $niveaux[6] = $2; + $niveaux[7] = $1; + $niveaux[0] = 7; + } + elsif ( $code =~ /^((((((00[12][A-Z])\d\d)[A-Z])\d\d)[A-Z])\d)/o ) { + $niveaux[1] = $6; + $niveaux[2] = $5; + $niveaux[3] = $4; + $niveaux[4] = $3; + $niveaux[5] = $2; + $niveaux[6] = $1; + $niveaux[0] = 6; + } + elsif ( $code =~ /^(((((00[12][A-Z])\d\d)[A-Z])\d\d)[A-Z])/o ) { + $niveaux[1] = $5; + $niveaux[2] = $4; + $niveaux[3] = $3; + $niveaux[4] = $2; + $niveaux[5] = $1; + $niveaux[0] = 5; + } + elsif ( $code =~ /^((((00[12][A-Z])\d\d)[A-Z])\d\d)/o ) { + $niveaux[1] = $4; + $niveaux[2] = $3; + $niveaux[3] = $2; + $niveaux[4] = $1; + $niveaux[0] = 4; + } + elsif ( $code =~ /^(((00[12][A-Z])\d\d)[A-Z])/o ) { + $niveaux[1] = $3; + $niveaux[2] = $2; + $niveaux[3] = $1; + $niveaux[0] = 3; + } + elsif ( $code =~ /^((00[12][A-Z])\d\d)/o ) { + $niveaux[1] = $2; + $niveaux[2] = $1; + $niveaux[0] = 2; + } + elsif ( $code =~ /^(00[12][A-Z])/o ) { + $niveaux[1] = $1; + $niveaux[0] = 1; + } + } +elsif ( $code =~ /^([567]\d\d)/o) { + if ( $base{$code} ) { + $niveaux[1] = $base{$code}; + } + else { + $niveaux[1] = $1; + } + $niveaux[0] = 1; + if ( $classe{$code} ) { + $niveaux[2] = $classe{$code}; + $niveaux[0] = 2; + } + if ( $code ne $niveaux[1] ) { + push(@niveaux, $code); + $niveaux[0] ++; + } + } + +return @niveaux; +} + +sub codes +{ +my ($langue, @liste) = @_; + +my $ligne = ""; +my $marge = 16; +my @lignes = (); +my %dejaVu = (); +my %inconnu = (); + +# my $ligne = " " x $marge . "\n"; +# push(@lignes, $ligne); + +foreach my $item (@liste) { + next if not $item; + my ($code) = $item =~ /^.:(.+)/o; + my @niveaux = niveaux($code); + if ( $code =~ /^00[12]/o ) { + for ( my $nb = $niveaux[0] ; $nb > 0 ; $nb -- ) { + my $cc = $niveaux[$nb]; + if ( not defined $equiv{'Pascal'}{$annee}{$cc} and + not defined $verb{$cc} ) { + if ( defined $canon{'Pascal'}{$cc} ) { + my @canon = keys %{$canon{'Pascal'}{$cc}}; + if ( $#canon == 0 ) { + $equiv{'Pascal'}{$annee}{$cc} = $canon[0]; + } + else { + my @items = sort {$canon{'Pascal'}{$b} <=> $canon{'Pascal'}{$a}} @canon; + $equiv{'Pascal'}{$annee}{$cc} = $items[0]; + } + } + else { + $inconnu{$cc} ++; + if ( $nb == $niveaux[0] ) { + $niveaux[0] --; + } + } + } + } + + } + next if $niveaux[0] < 1; + next if $dejaVu{$niveaux[$niveaux[0]]}; + $dejaVu{$niveaux[$niveaux[0]]} ++; + $ligne = " " x $marge . "\n"; + push(@lignes, $ligne); + $marge += 4; + for ( my $nb = 1 ; $nb <= $niveaux[0] ; $nb ++ ) { + my $cc = $niveaux[$nb]; + $ligne = " " x $marge . "$verb{$equiv}{$langue}\n"; + push(@lignes, $ligne); + $ligne = " " x $marge . "\n"; + push(@lignes, $ligne); + } + elsif ( $equiv{'Francis'}{$annee}{$cc} and + $equiv{'Francis'}{$annee}{$cc} ne $cc and + defined $verb{$equiv{'Francis'}{$annee}{$cc}}{$langue} ) { + my $equiv = $equiv{'Francis'}{$annee}{$cc}; + if ( $lodex{$equiv} ) { + $ligne .= " ref=\"$lodex{$equiv}\""; + } + $ligne .= ">\n"; + push(@lignes, $ligne); + $ligne = " " x ($marge + 4) . "$verb{$equiv}{$langue}\n"; + push(@lignes, $ligne); + $ligne = " " x $marge . "\n"; + push(@lignes, $ligne); + } + elsif ( defined $verb{$cc}{$langue} ) { + if ( $lodex{$cc} ) { + $ligne .= " ref=\"$lodex{$cc}\""; + } + $ligne .= ">\n"; + push(@lignes, $ligne); + if ( $inconnu{$cc} ) { + if ( $langue eq 'FR' ) { + $ligne = " " x ($marge + 4) . "Intitulé absent\n"; + } + elsif ( $langue eq 'EN' ) { + $ligne = " " x ($marge + 4) . "Term not available\n"; + } + } + else { + $ligne = " " x ($marge + 4) . "$verb{$cc}{$langue}\n"; + } + push(@lignes, $ligne); + $ligne = " " x $marge . "\n"; + push(@lignes, $ligne); + } + else { + print STDERR "Notice \"$inist\" : pas de verbalisation pour \"$cc\"\n"; + } + } + $marge -= 4; + push(@lignes, " " x $marge . "\n"); + } + +return @lignes +} + +sub motscles +{ +my ($langue, %motscles) = @_; + +my $marge = 20; +my @lignes = (); + +my $rnf = \%nff; +if ( $langue eq 'ENG' ) { + $rnf = \%nfe; + } + +foreach $num (sort {$a <=> $b} keys %{$motscles{$langue}}) { + my ($motcle) = keys %{$motscles{$langue}{$num}}; + my $type = undef; + my @nf = (); + if ( defined $motscles{$langue}{$num}{$motcle}{'type'} ) { + $type = $motscles{$langue}{$num}{$motcle}{'type'}; + } + if ( defined $motscles{$langue}{$num}{$motcle}{'nf'} ) { + @nf = @{$motscles{$langue}{$num}{$motcle}{'nf'}}; + } + my $ligne = " " x $marge . "\n"; + push(@lignes, $ligne); + $ligne = " " x $marge . " $motcle\n"; + push(@lignes, $ligne); + if ( @nf or $type ) { + $marge += 4; +# my $ligne = " " x $marge . "\n"; +# push(@lignes, $ligne); + foreach my $nf (@nf) { + my $intitule = $nf; + if ( defined $rnf->{$nf} ) { + $intitule = $rnf->{$nf}; + } + elsif ( defined $rnf->{lc($nf)} ) { + $intitule = $rnf->{lc($nf)}; + } + elsif ( $nf =~ /^[lqt][1-9]\z/io ) { + next; + } + else { + print STDERR "Notice \"$inist\" : NF \"$nf\" pour "; + print STDERR "mot-clé \"$motcle\"\n"; + next; + } + my $ligne = " " x $marge . "\n"; + push(@lignes, $ligne); + $ligne = " " x ($marge + 4) . "\n"; + push(@lignes, $ligne); + $ligne = " " x ($marge + 8) . "\n"; + push(@lignes, $ligne); + $ligne = " " x ($marge + 4) . "\n"; + push(@lignes, $ligne); + $ligne = " " x ($marge + 4) . "\n"; + push(@lignes, $ligne); + $ligne = " " x ($marge + 8) . "$intitule\n"; + push(@lignes, $ligne); + $ligne = " " x ($marge + 4) . "\n"; + push(@lignes, $ligne); + $ligne = " " x $marge . "\n"; + push(@lignes, $ligne); + } + if ( $type ) { + my $ligne = " " x $marge . "\n"; + push(@lignes, $ligne); + $ligne = " " x ($marge + 4) . "\n"; + push(@lignes, $ligne); + $ligne = " " x ($marge + 8) . "\n"; + push(@lignes, $ligne); + $ligne = " " x ($marge + 4) . "\n"; + push(@lignes, $ligne); + $ligne = " " x ($marge + 4) . "\n"; + push(@lignes, $ligne); + $ligne = " " x ($marge + 8) . "$rnf->{$type}\n"; + push(@lignes, $ligne); + $ligne = " " x ($marge + 4) . "\n"; + push(@lignes, $ligne); + $ligne = " " x $marge . "\n"; + push(@lignes, $ligne); + } +# $ligne = " " x $marge . "\n"; +# push(@lignes, $ligne); + $marge -= 4; + } + $ligne = " " x $marge . "\n"; + push(@lignes, $ligne); + } + +return @lignes; +} + + + +__DATA__ + +%% partie 1 + + + + + + + + Alignement Pascal/Francis — ISTEX + + enrichissement INIST-CNRS + INIST-CNRS + + + + ISTEX + + +

L’élément standOff de ce document est distribué sous licence + Creative Commons 4.0 non transposée (CC BY 4.0)

+

Ce standOff a été créé dans le cadre du projet ISTEX – Initiative + d’Excellence en Information Scientifique et Technique

+ + + + + + +%% partie 2 # + + D6F3AA7EDD75E1885C4BB439D518F98194569F42 + 95-0599541 + 6340873 + +%% partie 3 + + + + + + + + + + + + + Alignement Pascal/Francis — Istex + + + +%% partie 4 + + + %YEAR% + + +%% partie 5 # + + + SCIENCES APPLIQUEES. + BATIMENT. TRAVAUX PUBLICS. + Matériaux + + + SCIENCES APPLIQUEES. + INDUSTRIE DES POLYMERES, PEINTURES, BOIS. + Technologie des polymères + + + SCIENCES APPLIQUEES. + INDUSTRIES CHIMIQUE ET PARACHIMIQUE. + Matériaux de construction. Céramique. Verres. + Verres. + Structure, analyse, propriétés + + + SCIENCES APPLIQUEES. + BATIMENT. TRAVAUX PUBLICS. + Calcul des constructions. Sollicitations. + Résistance des matériaux (élasticité, plasticité, flambage, etc.) + + + BATIMENT. TRAVAUX PUBLICS. + + +%% partie 6 + + + + +%% partie 7 + + + %YEAR% + + +%% partie 8 # + + + APPLIED SCIENCES. + BUILDINGS. PUBLIC WORKS. + Materials + + + APPLIED SCIENCES. + POLYMER INDUSTRY, PAINTS, WOOD. + Technology of polymers. + + + APPLIED SCIENCES. + CHEMICAL INDUSTRY AND CHEMICALS. + Building materials. Ceramics. Glasses. + Glasses. + Structure, analysis, properties + + + APPLIED SCIENCES. + BUILDINGS. PUBLIC WORKS. + Structural analysis. Stresses. + Strength of materials (elasticity, plasticity, buckling, etc.) + + + BUILDINGS. PUBLIC WORKS. + + +%% partie 9 + + + + +%% partie 10 + + + + +%% partie 11 # + + + CIENCIAS APLICADAS. + Edificios; Obras publicas + Materiales + + + CIENCIAS APLICADAS. + INDUSTRIA DEL POLIMERO, PINTURAS, MADERAS. + Tecnologia de los polimeros + + + CIENCIAS APLICADAS. + Quimica. Ciencia de los materiales. + Materiales de construcción. Cerámica. Vidrio. + Vidrio + Estructura, análisis, propiedades. + + + CIENCIAS APLICADAS. + Edificios; Obras publicas + Calculo de las construcciones; Solicitaciones + Resistencia de los materiales (elasticidad, plasticidad, pandeo, etc.) + + + Edificios; Obras publicas + + +%% partie 12 + + + + +%% partie 13 + + + + + +%% partie 14 + + + Composite hybride + + + + + + Candidat descripteur + + + + Experience + + Ethylène polymère + + + + + + Composé chimique + + + + Fibre verre + +%% partie 15 + + + +# + + +%% partie 16 + + + + + +%% partie 17 # + + + Hybrid composites + + + + + + Descriptor candidate + + + + + Flexural modulus + + + + + + Uncontrolled index + + + + + Interlaminar shear strength + + + + + + Uncontrolled index + + + + Experiments + + Polyethylenes + + + + + + Chemical compound + + + + Glass fibers + +%% partie 18 + + + + + +%% partie 19 + + + + + +%% partie 20 # + + + Compuesto hibrido + + + + + + Candidato descriptor + + + + Experiencia + + Etileno polímero + + + + + + Compuesto quimico + + + + Fibra vidrio + +%% partie 21 + + + + + +%% partie 22 + + + + +%% FIN + +## +## Liste d’entités caractères +## + +## +## NE PAS MODIFIER ! +## +## DO NOT EDIT! +## + +33 excl +34 dquot +35 num +36 dollar +37 percnt +40 lpar +41 rpar +42 ast +43 plus +44 comma +45 hyphen +46 period +47 sol +58 colon +59 semi +61 equals +63 quest +64 commat +91 lsqb +92 bsol +93 rsqb +95 lowbar +96 grave +123 lcub +124 verbar +125 rcub +256 Amacr; +257 amacr; +258 Abreve; +259 abreve; +260 Aogon; +261 aogon; +262 Cacute; +263 cacute; +264 Ccirc; +265 ccirc; +266 Cdot; +267 cdot; +268 Ccaron; +269 ccaron; +270 Dcaron; +271 dcaron; +272 Dstrok; +273 dstrok; +274 Emacr; +275 emacr; +278 Edot; +279 edot; +280 Eogon; +281 eogon; +282 Ecaron; +283 ecaron; +284 Gcirc; +285 gcirc; +286 Gbreve; +287 gbreve; +288 Gdot; +289 gdot; +290 Gcedil; +291 gcedil; +292 Hcirc; +293 hcirc; +294 Hstrok; +295 hstrok; +296 Itilde; +297 itilde; +298 Imacr; +299 imacr; +302 Iogon; +303 iogon; +304 Idot; +305 inodot; +306 IJlig; +307 ijlig; +308 Jcirc; +309 jcirc; +310 Kcedil; +311 kcedil; +312 kgreen; +313 Lacute; +314 lacute; +315 Lcedil; +316 lcedil; +317 Lcaron; +318 lcaron; +319 Lmidot; +320 lmidot; +321 Lstrok; +322 lstrok; +323 Nacute; +324 nacute; +325 Ncedil; +326 ncedil; +327 Ncaron; +328 ncaron; +329 napos; +330 ENG; +331 eng; +332 Omacr; +333 omacr; +336 Odblac; +337 odblac; +340 Racute; +341 racute; +342 Rcedil; +343 rcedil; +344 Rcaron; +345 rcaron; +346 Sacute; +347 sacute; +348 Scirc; +349 scirc; +350 Scedil; +351 scedil; +354 Tcedil; +355 tcedil; +356 Tcaron; +357 tcaron; +358 Tstrok; +359 tstrok; +360 Utilde; +361 utilde; +362 Umacr; +363 umacr; +364 Ubreve; +365 ubreve; +366 Uring; +367 uring; +368 Udblac; +369 udblac; +370 Uogon; +371 uogon; +372 Wcirc; +373 wcirc; +374 Ycirc; +375 ycirc; +377 Zacute; +378 zacute; +379 Zdot; +380 zdot; +381 Zcaron; +382 zcaron; +501 gacute; +711 caron; +728 breve; +729 dot; +730 ring; +731 ogon; +733 dblac; +902 Aacgr; +904 Eacgr; +905 EEacgr; +906 Iacgr; +908 Oacgr; +910 Uacgr; +911 OHacgr; +912 idiagr; +913 Agr; +914 Bgr; +915 Ggr; +916 Dgr; +917 Egr; +918 Zgr; +919 EEgr; +920 THgr; +921 Igr; +922 Kgr; +923 Lgr; +924 Mgr; +925 Ngr; +926 Xgr; +927 Ogr; +928 Pgr; +929 Rgr; +931 Sgr; +932 Tgr; +933 Ugr; +934 PHgr; +935 KHgr; +936 PSgr; +937 OHgr; +938 Idigr; +939 Udigr; +940 aacgr; +941 eacgr; +942 eeacgr; +943 iacgr; +944 udiagr; +945 agr; +946 bgr; +947 ggr; +948 dgr; +949 egr; +950 zgr; +951 eegr; +952 thgr; +953 igr; +954 kgr; +955 lgr; +956 mgr; +957 ngr; +958 xgr; +959 ogr; +960 pgr; +961 rgr; +962 sfgr; +963 sgr; +964 tgr; +965 ugr; +966 phgr; +967 khgr; +968 psgr; +969 ohgr; +970 idigr; +971 udigr; +972 oacgr; +973 uacgr; +974 ohacgr; +977 thetav; +981 phiv; +988 gammad; +1008 kappav; +1009 rhov; +1025 IOcy; +1026 DJcy; +1027 GJcy; +1028 Jukcy; +1029 DScy; +1030 Iukcy; +1031 YIcy; +1032 Jsercy; +1033 LJcy; +1034 NJcy; +1035 TSHcy; +1036 KJcy; +1038 Ubrcy; +1039 DZcy; +1040 Acy; +1041 Bcy; +1042 Vcy; +1043 Gcy; +1044 Dcy; +1045 IEcy; +1046 ZHcy; +1047 Zcy; +1048 Icy; +1049 Jcy; +1050 Kcy; +1051 Lcy; +1052 Mcy; +1053 Ncy; +1054 Ocy; +1055 Pcy; +1056 Rcy; +1057 Scy; +1058 Tcy; +1059 Ucy; +1060 Fcy; +1061 KHcy; +1062 TScy; +1063 CHcy; +1064 SHcy; +1065 SHCHcy; +1066 HARDcy; +1067 Ycy; +1068 SOFTcy; +1069 Ecy; +1070 YUcy; +1071 YAcy; +1072 acy; +1073 bcy; +1074 vcy; +1075 gcy; +1076 dcy; +1077 iecy; +1078 zhcy; +1079 zcy; +1080 icy; +1081 jcy; +1082 kcy; +1083 lcy; +1084 mcy; +1085 ncy; +1086 ocy; +1087 pcy; +1088 rcy; +1089 scy; +1090 tcy; +1091 ucy; +1092 fcy; +1093 khcy; +1094 tscy; +1095 chcy; +1096 shcy; +1097 shchcy; +1098 hardcy; +1099 ycy; +1100 softcy; +1101 ecy; +1102 yucy; +1103 yacy; +1105 iocy; +1106 djcy; +1107 gjcy; +1108 jukcy; +1109 dscy; +1110 iukcy; +1111 yicy; +1112 jsercy; +1113 ljcy; +1114 njcy; +1115 tshcy; +1116 kjcy; +1118 ubrcy; +1119 dzcy; +8196 emsp13; +8197 emsp14; +8199 numsp; +8200 puncsp; +8202 hairsp; +8208 dash; +8211 ndash; +8212 mdash; +8213 horbar; +8214 Verbar; +8229 nldr; +8244 tprime; +8245 bprime; +8257 caret; +8259 hybull; +8411 tdot; +8412 DotDot; +8453 incare; +8459 hamilt; +8463 planck; +8466 lagran; +8467 ell; +8470 numero; +8471 copysr; +8478 rx; +8486 ohm; +8491 angst; +8492 bernou; +8499 phmmat; +8500 order; +8502 beth; +8503 gimel; +8504 daleth; +8531 frac13; +8532 frac23; +8533 frac15; +8534 frac25; +8535 frac35; +8536 frac45; +8537 frac16; +8538 frac56; +8539 frac18; +8540 frac38; +8541 frac58; +8542 frac78; +8597 varr; +8598 nwarr; +8599 nearr; +8600 drarr; +8601 dlarr; +8602 nlarr; +8603 nrarr; +8605 rarrw; +8606 Larr; +8608 Rarr; +8610 larrtl; +8611 rarrtl; +8614 map; +8617 larrhk; +8618 rarrhk; +8619 larrlp; +8620 rarrlp; +8621 harrw; +8622 nharr; +8624 lsh; +8625 rsh; +8630 cularr; +8631 curarr; +8634 olarr; +8635 orarr; +8636 lharu; +8637 lhard; +8638 uharr; +8639 uharl; +8640 rharu; +8641 rhard; +8642 dharr; +8643 dharl; +8644 rlarr2; +8646 lrarr2; +8647 larr2; +8648 uarr2; +8649 rarr2; +8650 darr2; +8651 lrhar2; +8652 rlhar2; +8653 nlArr; +8654 nhArr; +8655 nrArr; +8661 vArr; +8666 lAarr; +8667 rAarr; +8705 comp; +8708 nexist; +8714 epsis; +8717 bepsi; +8720 coprod; +8722 minus; +8723 mnplus; +8724 plusdo; +8726 setmn; +8728 compfn; +8735 ang90; +8737 angmsd; +8738 angsph; +8739 mid; +8740 nmid; +8741 par; +8742 npar; +8750 conint; +8757 becaus; +8765 bsim; +8768 wreath; +8769 nsim; +8771 sime; +8772 nsime; +8775 ncong; +8777 nap; +8778 ape; +8780 bcong; +8782 bump; +8783 bumpe; +8784 esdot; +8785 eDot; +8786 efDot; +8787 erDot; +8788 colone; +8789 ecolon; +8790 ecir; +8791 cire; +8793 wedgeq; +8796 trie; +8802 nequiv; +8806 lE; +8807 gE; +8808 lne; +8809 gne; +8810 Lt; +8811 Gt; +8812 twixt; +8814 nlt; +8815 ngt; +8816 nle; +8817 nge; +8818 lsim; +8819 gsim; +8822 lg; +8823 gl; +8826 pr; +8827 sc; +8828 pre; +8829 sce; +8830 prsim; +8831 scsim; +8832 npr; +8833 nsc; +8837 nsup; +8840 nsube; +8841 nsupe; +8842 subne; +8843 supne; +8846 uplus; +8847 sqsub; +8848 sqsup; +8849 sqsube; +8850 sqsupe; +8851 sqcap; +8852 sqcup; +8854 ominus; +8856 osol; +8857 odot; +8858 ocir; +8859 oast; +8861 odash; +8862 plusb; +8863 minusb; +8864 timesb; +8865 sdotb; +8866 vdash; +8867 dashv; +8868 top; +8871 models; +8872 vDash; +8873 Vdash; +8874 Vvdash; +8876 nvdash; +8877 nvDash; +8878 nVdash; +8879 nVDash; +8882 vltri; +8883 vrtri; +8884 ltrie; +8885 rtrie; +8888 mumap; +8890 intcal; +8891 veebar; +8892 barwed; +8900 diam; +8902 sstarf; +8903 divonx; +8904 bowtie; +8905 ltimes; +8906 rtimes; +8907 lthree; +8908 rthree; +8909 bsime; +8910 cuvee; +8911 cuwed; +8912 Sub; +8913 Sup; +8914 Cap; +8915 Cup; +8916 fork; +8918 ldot; +8919 gsdot; +8920 Ll; +8921 Gg; +8922 leg; +8923 gel; +8924 els; +8925 egs; +8926 cuepr; +8927 cuesc; +8928 npre; +8929 nsce; +8934 lnsim; +8935 gnsim; +8936 prnsim; +8937 scnsim; +8938 nltri; +8939 nrtri; +8940 nltrie; +8941 nrtrie; +8942 vellip; +8966 Barwed; +8972 drcrop; +8973 dlcrop; +8974 urcrop; +8975 ulcrop; +8981 telrec; +8982 target; +8988 ulcorn; +8989 urcorn; +8990 dlcorn; +8991 drcorn; +8994 frown; +8995 smile; +9251 blank; +9416 oS; +9472 boxh; +9474 boxv; +9484 boxdr; +9488 boxdl; +9492 boxur; +9496 boxul; +9500 boxvr; +9508 boxvl; +9516 boxhd; +9524 boxhu; +9532 boxvh; +9552 boxH; +9553 boxV; +9554 boxdR; +9555 boxDr; +9556 boxDR; +9557 boxdL; +9558 boxDl; +9559 boxDL; +9560 boxuR; +9561 boxUr; +9562 boxUR; +9563 boxuL; +9564 boxUl; +9565 boxUL; +9566 boxvR; +9567 boxVr; +9568 boxVR; +9569 boxvL; +9570 boxVl; +9571 boxVL; +9572 boxHd; +9573 boxhD; +9574 boxHD; +9575 boxHu; +9576 boxhU; +9577 boxHU; +9578 boxvH; +9579 boxVh; +9580 boxVH; +9600 uhblk; +9604 lhblk; +9608 block; +9617 blk14; +9618 blk12; +9619 blk34; +9633 squ; +9642 squf; +9645 rect; +9646 marker; +9651 xutri; +9652 utrif; +9653 utri; +9656 rtrif; +9657 rtri; +9661 xdtri; +9662 dtrif; +9663 dtri; +9666 ltrif; +9667 ltri; +9675 cir; +9733 starf; +9734 star; +9742 phone; +9792 female; +9794 male; +9834 sung; +9837 flat; +9838 natur; +9839 sharp; +10003 check; +10007 cross; +10016 malt; +10022 lozf; +10038 sext; +64256 fflig; +64257 filig; +64258 fllig; +64259 ffilig; + +## +## The End! +## diff --git a/alignement/README.md b/alignement/README.md deleted file mode 100644 index adfc5e9..0000000 --- a/alignement/README.md +++ /dev/null @@ -1,242 +0,0 @@ -Alignement Pascal-Francis / Istex -=============== - -Programme d’alignement des notices bibliographiques Inist avec les documents Istex - -Le programme `matchStan2Istex.pl` permet d’aligner les bases bibliographiques Pascal et Francis de l’**Inist** avec la base **Istex**, c’est-à-dire retrouver dans la base Istex les documents correspondants aux notices bibliographiques des base Pascal ou Francis. - -À noter que si ce programme est utilisé à l'Inist, il est recommandé d’éviter de passer par le proxy. Pour cela, il faut supprimer les variables globales le définissant, ce qui se fait avec la commande  : `unset http_proxy https_proxy no_proxy`. Vérifiez également avec la commande `env` si ces mêmes variables n'existent pas en majuscule. Auquel cas, supprimez les avec la commande : `unset HTTP_PROXY HTTPS_PROXY NO_PROXY`. - - -### Prérequis - -Le programme `matchStan2Istex.pl` fonctionne sous Unix/Linux ainsi qu’avec Cygwin sous Windows. Il utilise plusieurs modules qui ne sont pas tous dans la distribution standard de **Perl**. Les modules qu’on peut être amené à installer sont : - - - HTML::Entities - - HTTP::CookieJar::LWP - - JSON - - LWP::userAgent - - Number::Convert::Roman - - Text::Unidecode - - URI::Encode - -Il peut aussi être nécessaire d’avoir le programme `IhfdCat` pour accéder aux notices **Inist** i eles sont dans un fichier **HFD** (voir [divers](../../../tree/master/divers)). - - -### Usage - -```txt - matchStan2Istex.pl -f (fichier|-) [ -d ] [ -v nombre ] [ -r id ] - [ -n notices ] [ -c corpus[,corpus]* ]* - matchStan2Istex.pl -h fichier_HFD [ -d ] [ -v nombre ] [ -r id ] - [ -n notices ] [ -c corpus[,corpus]* ]* - matchStan2Istex.pl -i -``` - - -### Options - -``` - -c indique le nom du ou des corpus de la base Istex à interroger (on peut soit répéter - cette option, soit mettre tous les noms de corpus séparés par des virgules, mais sans - espace) - -d active le mode “débogage” - -f indique le nom du fichier d’entrée (qui peut être un fichier compressé avec “gzip” ou - “bzip2”). Pour utiliser l’entrée standard, mettre un tiret “-” - comme argument - -h indique le nom du fichier HFD servant d’entrée au programme - -i affiche cette aide. - -n indique le nom du fichier contenant les notices Pascal ou Francis modifiées parce - que les notices originales provoquaient une erreur de syntaxe dans la requête à l’API - ISTEX (N.B. : l’absence du fichier indiqué n’entraîne pas l’arrêt du programme) - -r indique le numéro de la dernière notice Pascal ou Francis traitée précédemment, pour - permettre la reprise de l’alignement si celui-ci a été prématurément arrêté - -v permet de suivre la progression du traitement en affichant sur la sortie erreur l’heure - de début, l’heure de fin et l’heure chaque fois qu’un lot de notices, correspondant au - nombre de notices donné en argument, a été traité -``` - - -### Formats d’entrée et de sortie - -#### 1 - Notices Inist - -Les notices bibliographiques des bases Pascal et Francis sont des documents balisés en [SGML](https://fr.wikipedia.org/wiki/Standard_Generalized_Markup_Language) (norme ISO 8879:1986). Chaque notice est sur une seule ligne et à chaque balise ouvrante correspond une balise fermante. En dehors des lettres majuscules et minuscules non-accentuées, des chiffres et des signes de ponctuation de base, les caractères sont écrits sous forme d’entité caractère (par exemple, `é` pour le caractère `é`). À l’inverse de ce qu’on peut trouver dans [XML](https://fr.wikipedia.org/wiki/Extensible_Markup_Language) (qui est un sous-ensemble de SGML), les valeurs d’attribut ne sont pas entre *quotes*, simples ou doubles et il n'y a pas de balise vide. - -La racine du document est l’élément `record` et il y a deux niveaux de balise correspondant aux zones et sous-zones du format d’échange de notices bibliographiques de la norme [ISO 2709](https://fr.wikipedia.org/wiki/ISO_2709) comme on peut le voir dans l’exemple ci-dessous (indenté par souci de lisibilité). La sémantique des noms de zone, préfixés par `f` en SGML, des noms de sous-zone, préfixés par `s` en SGML, et de l’attribut `dir` est défini dans le document « Format INIST Standard 1994 ». - -```sgml - - - 0138-9130 - - - SCNTDX - - - Scientometrics : (Print) - - - 72 - - - 2 - - - Profiling citation impact : A new methodology - - - ADAMS (Jonathan) - - - GURNEY (Karen) - - - MARSHALL (Stuart) - - - Evidence Ltd - Leeds - GBR - 1 aut. - 2 aut. - 3 aut. - - ... - - Aide décision - 18 - - - Decision aid - 18 - - - Ayuda decisión - 18 - - - 203 - - -``` - -#### 2 - Sortie standard - -##### Cas général - -Pour chaque notice Inist traitée, et sauf pour 2 exceptions que l’on verra plus loin, on a une première ligne commençant par `URI` et indiquant la requête envoyée à l’API. La ligne suivante donne le nombre de réponses obtenues. - -```txt -URI : "https://api.istex.fr/document/?q=(host.title:"Scientometrics" OR host.issn:"0138-9130" OR host.eissn:"0138-9130" -OR serie.issn:"0138-9130" OR serie.eissn:"0138-9130") AND (publicationDate:2007 OR copyrightDate:2007 OR host.publicationDate:2007 -OR host.copyrightDate:2007 OR serie.publicationDate:2007 OR serie.copyrightDate:2007 OR host.volume:72 OR host.issue:2) AND -(author.name:("ADAMS" OR "GURNEY" OR "MARSHALL") OR host.pages.first:[325 TO 344] OR host.pages.last:[325 TO 344]) -&output=title,author,host,serie,doi,publicationDate,copyrightDate" - => 68 -``` - -On peut ensuite trouver d’autres requêtes commençant par `ALT`, `ETC` ou `RAC`. Ces requêtes complémentaires servent soit à tester une autre stratégie de recherche (`RAC`), soit à essayer différentes valeurs pour la pagination (`ETC`) ou soit à rechercher un groupe de documents indexés dans une seule notice Inist (`ALT`). Les requêtes de type `ETC` et `RAC` sont suivies d’une ligne indiquant le nombre de réponse renvoyées par l¹API. - -Dans le cas le plus général, on a ensuite le résultat sur une ligne avec 22 champs, pas toujjours remplis, séparés par des tabulations. On a respectivement : - - une note exprimée à l’aide d’astérisques (1 étoile) et de signes plus (½ étoile), de `*****` à `0` - - le score, de `5.000` à `0.000`, parfois suivi d’un point d’exclamation `!` - - le niveau bibliographique : `A` pour un article et `M` pour une monographie - - le numéro Inist de la notice - - le titre du document - - le nom de la revue - - le titre de la monographie - - ISSN - - ISBN - - l’année de publication - - le n° de volume - - le n° de fascicule - - la page de début - - la page de fin - - le nom du premier auteur - - le prénom du premier auteur - - la liste des auteurs suivants séparés par une barre verticale `|` - - l’identifiant Istex - - l’identifiant pérenne ARK - - l’identifiant DOI - - l’identifiant PII - - l’identifiant PMID - -Dans l’exemple suivant, on a rajouté un signe d’exclamation aux champs vides pour permettre de les repérer. - -```txt -***** 5.000 A 08-0322753 Profiling citation impact : A new methodology Scientometrics ! 0138-9130 ! -2007 72 2 325 344 ADAMS Jonathan GURNEY, Karen|MARSHALL, Stuart 16AA6F7A70CD152792DC04F6D65A673B8B7F2214 -ark:/67375/VQC-DZRDKVN2-2 10.1007/s11192-007-1696-x ! ! -``` - -On considère que l'alignement est bon si le score est supérieur ou égal à `3.490`. Pour les scores inférieurs à cette valeur, on a parfois un point d’exclamation `!` qui indique que les données bibliographiques sur la revue, l’année de publication, la volumaison, la tomaison (si elle existe) et la pagination sont correctes, mais que le reste des données ne correspond pas. Cela peut être dû à des fautes de frappe ou d’OCR dans les noms d’auteur ou dans le titre, ou cela peut être dû à une erreur de bulletinage : le document s'est vu attribuer par exemple la pagination d’un autre article du même fascicule. On trouve de tels décalages aussi bien dans les données Inist que dans celles des éditeurs. - -##### Messages divers - -On peut aussi avoir des messages, pas forcément d’erreur, après la requête. Ils sont précédés d’une flèche, ont un texte en majuscule et se terminent par un point d’exclamation, comme `=> CORRECTION MAC !`. Ils indiquent un traitement particulier et ont servi à perfectionner le programme. - -Les véritables erreurs sont indiquées comme telles. Ont a 3 types d’erreur : - - - requête incorrecte `=> ERREUR 400 "400 Bad Request" !` - - problème de connexion au serveur `=> ERREUR 500 "500 Internal Server Error" !` - - mauvaise conversion de JSON vers Perl `=> ERREUR CONVERSION JSON -> PERL !` - -La première est due aux données de la notice Inist. En utilisant les notices corrigées, cela ne devrait plus arriver. Les deux autres sont des problèmes temporaires qu'on peut corriger avec le programme `recupErreurs.pl` dans le répertoire “**correction**”. - -##### Notices groupées - -Certaines notices Inist concernent non pas un article, mais un groupe d’articles pour différentes raisons : - - - “Pro and con” : en médecine, deux auteurs (ou groupes d’auteurs) discutent d’un sujet, comme une procédure médicale, et un auteur est pour, l’autre est contre. - - juste à la suite d’un article, on a un commentaire d’un autre auteur, voire la réponse du premier auteur aux commentaires sur son article. - - plusieurs articles associés, déjà regroupés dans le fascicule et traitant du même sujet. - -Les différents articles pouvant être regroupés sont indiqués après le résultat général. Pour chaque article, on a une flèche ` ~~> ` suivie de 7 champs séparés par des tabulations. On a respectivement : - - - la première page - - la dernière page - - la liste des auteurs séparés par une barre verticale `|` - - le titre de l’article - - l’identifiant Istex - - l’identifiant pérenne ARK - - l’identifiant DOI - -Ces document sont présentés normalement dans l’ordre de la pagination, comme dans cet exemple article/commentaires/réponses. - -```txt - ~~> 2 10 I. P. Stolerman|M. J. Jarvis The scientific case that nicotine is addictive 5A8E718F07659D84B0480F8D78D661F0E17ECAC6 ark:/67375/1BB-TFLHTXVC-4 10.1007/BF02245088 - ~~> 11 13 J. E. Henningfield|S. J. Heishman The addictive role of nicotine in tobacco use B16BD3EAB82D95F6780752DAEC1ABB1E1FAA27BF ark:/67375/1BB-3ZB0VPRG-6 10.1007/BF02245089 - ~~> 14 15 S. Shiffman Comments on nicotine addiction 79BF81FCD57EECD784BC85C823992173162BE5C1 ark:/67375/1BB-QWBZ3DS5-C 10.1007/BF02245090 - ~~> 16 17 J. H. Robinson|W. S. Pritchard Reply to stolerman and jarvis 70F7FD3CA45D99F42EAD372FF607CAC82376B7EA ark:/67375/1BB-0KBPPP8C-F 10.1007/BF02245091 - ~~> 18 20 M. E. Jarvik Commentary DC536BE3D44EEC8BCA32DCFE79FE23590494CA35 ark:/67375/1BB-JZ3PB2LS-Z 10.1007/BF02245092 - ~~> 21 22 J. H. Jaffe Commentary on the nicotine IS/IS not addictive debate 5B0620646FBF8A3785C50F3597709ED9B25DA216 ark:/67375/1BB-XFHN05CC-V 10.1007/BF02245093 -``` - -##### Exceptions - -Dans deux cas, on n’a pas de requête, mais seulement un résultat nul : pour les monographies et pour les articles dont la revue n’est pas dans la base Istex. Dans le premier cas, la note est un *underscore* `_`, le score est un tiret `-` et le niveau bibliographique est `M`. Dans le deuxième cas, on a le même résultat que lorsque l’API n’a trouvé aucun document, mais sans la requête. En fait, au premier article d’une revue, on teste la présence de cette revue dans la base. Si la réponse est nulle, tous les autres articles de la même revue ne font l’objet d’aucune recherche inutile. - -#### 3 - Erreur standard - -En cas d’utilisation de l’option `-v`, le programme envoie par la sortie “erreur standard” des messages sur le travail en cours. On a : - - le nom du programme et sa version (sauf dans les anciennes versions du programme) - - en cas de reprise d’un travail interrompu, le n° de la dernière notice Inist - - le nom du fichier traité ou la mention `entrée standard` - - la date et l’heure de début du traitement - - la date et l’heure auxquelles on a terminé un lot de notices correspondant à la valeur de l’option `-v` - - la date te l’heure de fin de traitement avec rappel du nombre de notices traitées - -```txt -==> matchStan2Istex.pl, version 14.3.2 (24 Août 2020) -*** Notices traitées : 2008/Pascal.strd08.bib *** - -> Mardi 29 Septembre 2020 03:27:56 : début - -> Mardi 29 Septembre 2020 03:29:47 : 10000 notices - -> Mardi 29 Septembre 2020 03:31:13 : 20000 notices - -> Mardi 29 Septembre 2020 03:32:59 : 30000 notices - ... - -> Mardi 29 Septembre 2020 04:45:50 : 480000 notices - -> Mardi 29 Septembre 2020 04:47:26 : 490000 notices - -> Mardi 29 Septembre 2020 04:48:35 : fin = 497745 notices -``` - diff --git a/alignement/matchStan2Istex.pl b/alignement/matchStan2Istex.pl deleted file mode 100755 index 6b43b4f..0000000 --- a/alignement/matchStan2Istex.pl +++ /dev/null @@ -1,3082 +0,0 @@ -#!/usr/bin/perl - - -# Déclaration des pragmas -use strict; -use utf8; -use open qw/:std :utf8/; -## use warnings::unused; -## use warnings 'once'; - -# Appel des modules externes de base -use Encode; -use Getopt::Long; - -# Appel des modules spécifiques à l'application -use HTML::Entities qw(decode_entities %entity2char); -use HTTP::CookieJar::LWP; -use JSON; -use LWP::UserAgent; -use Number::Convert::Roman; -use Text::Unidecode; -use URI::Encode qw(uri_encode uri_decode); - -my ($programme) = $0 =~ m|^(?:.*/)?(.+)|; -my $substitut = " " x length($programme); -my $version = "15.3.1"; -my $dateModif = "4 Octobre 2021"; - -my $usage = "Usage : \n" . - " $programme -f (fichier|-) [ -d ] [ -v nombre ] [ -r id ] \n" . - " $substitut [ -n notices ] [ -c corpus[,corpus]* ]* \n" . - " $programme -h fichier_HFD [ -d ] [ -v nombre ] [ -r id ] \n" . - " $substitut [ -n notices ] [ -c corpus[,corpus]* ]* \n" . - " $programme -i \n"; - -my $debug = undef; -my $fichier = undef; -my $hfd = undef; -my $info = undef; -my $notices = undef; -my $reprise = undef; -my $verbeux = undef; -my @corpus = (); - -eval { - $SIG{__WARN__} = sub {usage(1);}; - GetOptions( - "corpus=s" => \@corpus, - "notices=s" => \$notices, - "info" => \$info, - "debug" => \$debug, - "fichier=s" => \$fichier, - "hfd=s" => \$hfd, - "reprise=s" => \$reprise, - "verbeux=i" => \$verbeux, - ); - }; -$SIG{__WARN__} = sub {warn $_[0];}; - -if ( $info ) { - print "Programme : \n"; - print " “$programme”, version $version ($dateModif)\n"; - print " Permet de chercher les correspondances entre les notices bibliographiques des bases Pascal \n"; - print " et Francis de l’INIST et les documents de la base ISTEX. \n"; - print "\n"; - print $usage; - print "\nOptions : \n"; - print " -c indique le nom du ou des corpus de la base ISTEX à interroger (on peut soit répéter \n"; - print " cette option, soit mettre tous les noms de corpus séparés par des virgules, mais sans \n"; - print " espace) \n"; - print " -d active le mode “débogage” \n"; - print " -f indique le nom du fichier d’entrée (qui peut être un fichier compressé avec “gzip” ou \n"; - print " “bzip2”). Pour utiliser l’entrée standard, mettre un tiret “-” \n"; - print " comme argument \n"; - print " -h indique le nom du fichier HFD servant d’entrée au programme \n"; - print " -i affiche cette aide. \n"; - print " -n indique le nom du fichier contenant les notices Pascal ou Francis modifiées parce \n"; - print " que les notices originales provoquaient une erreur de syntaxe dans la requête à l’API \n"; - print " ISTEX (N.B. : l’absence du fichier indiqué n’entraîne pas l’arrêt du programme) \n"; - print " -r indique le numéro de la dernière notice Pascal ou Francis traitée précédemment, pour \n"; - print " permettre la reprise de l’alignement si celui-ci a été prématurément arrêté \n"; - print " -v permet de suivre la progression du traitement en affichant sur la sortie erreur l’heure \n"; - print " de début, l’heure de fin et l’heure chaque fois qu’un lot de notices, correspondant au \n"; - print " nombre de notices donné en argument, a été traité \n"; - print " \n"; - print "N.B. : pour ne pas passer par le proxy sur le réseau interne de l’INIST, il faut effacer les \n"; - print " variables globales du proxy par la commande “unset http_proxy https_proxy no_proxy” \n"; - print " avant de lancer le programme “$programme”. \n"; - print " Également, l’absence du fichier donné par l’option “-n” n’entraîne pas l’arrêt du \n"; - print " programme, seulement un message d’erreur. \n"; - print " \n"; - - exit 0; - } - -usage(2) if not $fichier and not $hfd; -usage(2) if $fichier and $hfd; - -if ( @corpus ) { - @corpus = split(/,/, join(",", @corpus)); - } - -if ( $verbeux ) { - if ( $verbeux < 0 ) { - print STDERR "\n$programme : l’option “-v” doit être un entier positif !\n"; - exit(3); - } - } - -# Complétion de la table des entitées HTML -while() { - next if /^\s*$/o or /^#/o; - chomp; - my ($num, $sgml) = split(/\t+/); - next if $entity2char{$sgml}; - $entity2char{$sgml} = chr($num); - } -close DATA; - -# Paramètres de l'API ISTEX -my $base = "https://api.istex.fr"; -my $url = "$base/document/?q="; -my $out = "output=author,copyrightDate,doi,host,pii,pmid,publicationDate,serie,title"; -my $size = 100; -my $echec = 0; - -# Initialisation de l'agent -my $agent = LWP::UserAgent->new( - cookie_jar => HTTP::CookieJar::LWP->new, - ); -$agent->agent("$programme/$version"); -$agent->default_header("Accept" => "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"); -$agent->default_header("Accept-Language" => "fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3"); -$agent->default_header("Accept-Encoding" => "gzip, deflate"); -$agent->default_header("Connection" => "keep-alive"); - -# Allongement du temps d'attente -$agent->timeout(300); -$agent->env_proxy; - -# Déclaration des variables concernant la notice à chercher -my $date = ""; -my $fascicule = ""; -my $isbn = ""; -my $issn = ""; -my $journal = ""; -my $label = ""; -my $livre = ""; -my $nivbib = ""; # Niveau bibliographique (A, M ou C); -my $nom1 = ""; # Nom du premier auteur -my $num = ""; -my $pagedebut = ""; -my $pagefin = ""; -my $prenom1 = ""; # Prénom du premier auteur -my $titre = ""; -my $volume = ""; -my @autres = (); # Auteurs (autres que le premier auteur) -my @isbns = (); -my @issns = (); -my @journaux = (); -my @langues = (); -my @livres = (); -my @pages = (); -my @titres = (); -my %modifs = (); -my %notice = (); -my %pages = (); -my %pb = (); -my %rdvfp = (); -my %source = (); - -# Déclaration d'un hachage général pour éviter de répéter les -# messages plusieurs fois pour la même notice -my @alertes = (); -my %alerte = (); - -# Nombre de notices traitées -my $notice = 0; - -# Initialisation du convertisseur de chiffres romains -my $convert = Number::Convert::Roman->new; - -# Sortie sans “buffer” -select STDERR; -$| = 1; -select STDOUT; -$| = 1; - -# Récupération des notices alternatives du fichier indiqué -# par l’option “- a” -if ( $notices ) { - if ( -f $notices ) { - open(INP, "<:raw", $notices) or die "$!,"; - while() { - next if /^\s*$/o or /^#/o; - ($num) = m|(.+?)|o; - $notice{$num} = $_; - } - close INP; - if ( $verbeux ) { - print STDERR "*** Fichier de notices corrigées : $notices *** \n"; - } - } - elsif ( $verbeux ) { - print STDERR "*** Fichier de notices corrigées “$notices” absent *** \n"; - } - } - -if ( defined $fichier ) { - if ( $fichier eq '-' ) { - open(INP, "<&STDIN") or die "$!,"; - binmode(INP, ":raw"); - } - elsif ( $fichier =~ /\.gz\z/o ) { - open(INP, "gzip -cd $fichier |") or die "$!,"; - binmode(INP, ":raw"); - } - elsif ( $fichier =~ /\.bz2\z/o ) { - open(INP, "bzip2 -cd $fichier |") or die "$!,"; - binmode(INP, ":raw"); - } - else { - open(INP, "<:raw", $fichier) or die "$!,"; - } - } -elsif ( defined $hfd ) { - open(INP, "IhfdCat $hfd |") or die "$!,"; - binmode(INP, ":raw"); - } - -if ( $verbeux ) { - print STDERR "==> $programme, version $version ($dateModif) <== \n"; - if ( $reprise ) { - print STDERR "*** Reprise du traitemment après la notice \"$reprise\" *** \n"; - } - else { - if ( defined $hfd ) { - print STDERR "*** Notices traitées : $hfd *** \n"; - } - elsif ( defined $fichier ) { - if ( $fichier eq '-' ) { - print STDERR "*** Notices traitées : entrée standard *** \n"; - } - else { - print STDERR "*** Notices traitées : $fichier *** \n"; - } - } - my $moment = date(); - print STDERR " -> $moment : début\n"; - } - } - -if ( defined $reprise ) { - while() { - next if /^\s*$/o; - # Recherche du numero de notice. - ($num) = m|(.+?)|o; - $notice ++; - if ( $num eq $reprise ) { - if ( $verbeux ) { - my $moment = date(); - print STDERR " -> $moment : reprise = $notice notices\n"; - } - last; - } - } - } - -# Modification de l’URL de base si la requête est restreinte à un -# (ou plusieurs) corpus plutôt qu’à l’ensemble de la base ISTEX -if ( @corpus ) { - if ( $#corpus == 0 ) { - $url .= "corpusName:$corpus[0]+AND+" - } - else { - $url .= "corpusName:(" . join("+", @corpus) . ")+AND+" - } - } - -while() { - next if /^\s*$/o; - next if /^#/o; - - # Message pour chaque "$verbeux" notices traitées - $notice ++; - if ( $verbeux and $notice % $verbeux == 0 ) { - my $moment = date(); - print STDERR " -> $moment : $notice notices\n"; - } - - # Remise à zéro des alertes - %alerte = (); - - # Recherche du niveau bibbliographique. - ($nivbib) = m|([AMC])|o; - - # Recherche du numero de notice. - ($num) = m|(.+?)|o; - if ( not $num ) { - print STDERR "pas de numéro INIST pour la notice #$notice\n"; - next; - } - - - if ( $notice{$num} ) { - $_ = $notice{$num}; - } - - # Prétraitement de la notice avant découpe - chomp; - s/\r//o; - s|||o; - # Problème de l'entité "&dquot;" et des trémas - s/&dquot;/"/go; - s/&(\w)\.die;/&${1}uml;/go; - s/&Lstok;/Ł/go; - - # Découpe des champs. - my @champs = split(/(.+?)|o; - push(@langues, $langue); - } - - # Recherche du titre en fonction du niveau bib. - $titre = ""; - if ( $nivbib eq "A" ) { - my @titres = grep(/^A[06]8 /, @champs); - ($titre) = $titres[0] =~ m|(.+?)|o; - } - elsif ( $nivbib eq "M" ) { - my @titres = grep(/^A[06]9 /, @champs); - ($titre) = $titres[0] =~ m|(.+?)|o; - } - elsif ( $nivbib eq "C" ) { - my @titres = grep(/^A[17]0 /, @champs); - ($titre) = $titres[0] =~ m|(.+?)|o; - } - else { - print STDERR "Attention : pas de titre pour notice n° $num, ligne $.\n"; - } - # On pense à mettre le titre INIST en UTF-8, mais une seul fois - $titre = decode_entities($titre); - - # Recherche du titre de journal. - my @tmp = (); - my %tmp = (); - $journal = ""; - @journaux = grep(/^A64 /, @champs); - if ( $#journaux == -1 ) { - @journaux = grep(/^A03 /, @champs); - } - foreach my $item (@journaux) { - ($journal) = $item =~ m|(.+?)|o; - push(@tmp, $journal); - } - @journaux = grep(/./, @tmp); - foreach my $item (@journaux) { - if ( $item =~ /^([A-Z]{3,})\. (\p{isUpper}(\p{isAlpha}|&\w+;)+.*)/o ) { - push(@journaux, $1); - push(@journaux, $2); - } - $item =~ s/ : .*//o; - $item =~ s/^\s*\(([^)]+)\) +/$1 /o; - $item =~ s/^(.+) +\(([^)]+)\)\s*\z/$2 $1/o; - if ( $tmp{$item} ) { - $item = ""; - } - else { - $tmp{$item} ++; - } - } - @journaux = grep(/./, @journaux); - if ( $#journaux >= 0 ) { - $journal = $journaux[0]; - } - - # Recherche du titre du livre. - %tmp = (); - $livre = ""; - @livres = grep(/^A09 /, @champs); - foreach my $item (@livres) { - ($livre) = $item =~ m|(.+?)|o; - if ( $tmp{$livre} ) { - $item = ""; - } - else { - $item = $livre; - $tmp{$livre} ++; - } - } - @livres = grep(/./, @livres); - if ( $#livres >= 0 ) { - $livre = $livres[0]; - } - - # Recherche de l'ISSN. - %tmp = (); - $issn = ""; - @issns = grep(/^A01 /, @champs); - foreach my $item (@issns) { - ($issn) = $item =~ m|(.+?)|o; - if ( $issn =~ /^(\d\d\d\d)[^-](\d\d\d[0-9Xx])\z/o ) { - $issn = "$1-$2"; - } - elsif ( $issn =~ /^(\d\d\d\d)/(\d\d\d[0-9Xx])\z/o ) { - $issn = "$1-$2"; - } - if ( $tmp{$issn} ) { - $item = ""; - } - else { - $item = $issn; - $tmp{$issn} ++; - } - } - @issns = grep(/./, @issns); - if ( $#issns >= 0 ) { - $issn = $issns[0]; - } - - # Recherche de l'ISBN. - %tmp = (); - $isbn = ""; - @isbns = grep(/^A26 /, @champs); - foreach my $item (@isbns) { - ($isbn) = $item =~ m|(.+?)|o; - if ( $tmp{$isbn} ) { - $item = ""; - } - else { - $item = $isbn; - $tmp{$isbn} ++; - } - } - @isbns = grep(/./, @isbns); - if ( $#isbns >= 0 ) { - $isbn = $isbns[0]; - } - - # Recherche de la date de publication - if ( m|(.+?)|o ) { - my $tmp = $1; - if ( $tmp =~ /^[12]\d\d\d/ ) { - $date = substr($tmp, 0, 4); - } - else { - $date = undef; - } - } - - # Recherche du numéro de volume - $volume = ""; - if ( m|(.+?)|o ) { - $volume = $1; - $volume =~ s/^\s+//o; - $volume =~ s/\s+\z//o; - $volume =~ s|/|/|go; - if ( $volume =~ m|^(\d+)[-/](\d+)\z|o ) { - my $nb1 = $1; - my $nb2 = $2; - if ( $nb1 > $nb2 and length($nb1) > length($nb2) ) { - my $diff = length($nb1) - length($nb2); - $nb2 = substr($nb1, 0, $diff) . $nb2; - $volume = "$nb1-$nb2"; - } - } - } - - # Recherche du numéro de fascicule - $fascicule = ""; - if ( m|(.+?).*|o ) { - $fascicule = $1; - $fascicule =~ s/^\s+//o; - $fascicule =~ s/\s+\z//o; - $fascicule =~ s/&(horbar|mdash|minus);/-/go; - $fascicule =~ s/ *, */-/go; - $fascicule =~ s/-\s*\z//o; - $fascicule =~ s|/|/|go; - } - - # Recherche des numéros de page - @pages = (); - ($pagedebut, $pagefin) = ("", ""); - if ( m|(.+?)|o ) { - my $champ = $1; - my $pages = ""; - if ( $champ =~ m|(.+?)|o ) { - $pages = $1; - } - elsif ( $champ =~ m|(.+?)|o ) { - $pages = $1; - } - if ( $pages !~ /^\s*\z/o ) { - $pages =~ s/•/./go; - $pages =~ s/&(horbar|mdash|minus);/-/go; - $pages =~ s/ / /go; - $pages =~ s/^ +//o; - $pages =~ s|/|/|go; - if ( $pages =~ /^(&\w+gr; )?vol\. *\S+?, */io or - $pages =~ /^(&\w+gr; )?vol \S+?, */io or - $pages =~ /^(&\w+gr; )?vol\d+, */io or - $pages =~ /^&\w+gr;,? */o ) { - $pages = $'; - } - if ( $pages =~ / *[.+?(].*)?.*\z/io or - $pages =~ / +\d+ p\.].*/io ) { - $pages = $`; - } - if ( $pages =~ / *\(.+?\).*\z/io ) { - $pages = $`; - } - if ( $pages =~ /^([0ivx][ivx]*(-[ivx]+)?,? *([ivx]+(-[ivx]+)?,? *)*) (.+)\z/io ) { - $pages = $5; - } - if ( $pages =~ /^ *(.+?)(, *[ivx]+(-[ivx]+)?((, *| +)[ivx]+(-[ivx]+)?)*,? *)\z/io ) { - my $tmp = $1; - if ( $pages !~ /^ *[ivx]+(-[ivx]+)?((, *| +)[ivx]+(-[ivx]+)?)*,? *\z/io ) { - $pages = $tmp; - } - } - if ( $pages =~ /^s\.p\.\s*\z/io ) { - $pagedebut = undef; - } - elsif ( $pages =~ /^(\d+)-(\d+) +p\./io ) { - $pagedebut = $1; - $pagefin = $2; - } - elsif ( $pages =~ /^\S+ +p\./io ) { - $pagedebut = undef; - } - elsif ( $pages =~ /^p\. *(\S+)\z/io ) { - $pagedebut = $1; - } - elsif ( $pages =~ /^(\S+-\S+)-(\S+-\S+)\z/o ) { - $pagedebut = $1; - $pagefin = $2; - } - elsif ( $pages =~ /^(\S+?)(-\S+)?,( *(\S+-)?(\S+),)* *(\S+-)?(\S+) *\z/o ) { - $pages[0] = { 'debut' => $1, 'fin' => $7 }; - my @items = split(/, */, $pages); - while(my $item = shift @items) { - if ( $item =~ /^(\S+?)-(\S+) *\z/o ) { - push(@pages, {'debut' => $1, 'fin' => $2,}); - } - else { - if ( @items ) { - push(@pages, {'debut' => $item, 'fin' => "",}); - } - else { - push(@pages, {'debut' => "", 'fin' => $item}); - } - } - } - } - elsif ( $pages =~ /^(\S+?)-(\S+) *\z/o ) { - $pagedebut = $1; - $pagefin = $2; - } - elsif ( $pages =~ /^(\S+) *\z/o ) { - $pagedebut = $1; - } - } - } - - # Recherche du premier auteur - $nom1 = ""; - $prenom1 = ""; - my @auteurs = (); - if ( $nivbib eq "A" ) { - @auteurs = grep(!//, grep(/^A11 /, @champs)); - if ( $#auteurs < 0 ) { - @auteurs = grep(/^A11 /, @champs); - } - } - elsif ( $nivbib eq "M" ) { - @auteurs = grep(!//, grep(/^A12 /, @champs)); - if ( $#auteurs < 0 ) { - @auteurs = grep(/^A12 /, @champs); - } - } - elsif ( $nivbib eq "C" ) { - @auteurs = grep(!//, grep(/^A13 /, @champs)); - if ( $#auteurs < 0 ) { - @auteurs = grep(/^A13 /, @champs); - } - } - if ( $auteurs[0] ) { - my ($auteur) = $auteurs[0] =~ m|(.+?)|o; - if ( $auteur =~ /^(.+?) *\((.+?)\) *\z/ ) { - $nom1 = $1; - $prenom1 = $2; - } - else { - $nom1 = $auteur; - } - shift @auteurs; - } - - # Autres auteurs - @autres = (); - foreach my $suivant (@auteurs) { - my ($auteur) = $suivant =~ m|(.+?)|o; - if ( $auteur =~ /^(.+?) *\((.+?)\) *\z/ ) { - push(@autres, "$1, $2"); - } - else { - push(@autres, $auteur); - } - } - my $autres = join("|", @autres); - - # Recherche ISTEX - # Cas n° 1 : article de revue - if ( $nivbib eq "A" and ( $journal or $issn ) ) { - if ( @pages ) { - my $max = 0.0; - my %alt = (); - $label = "\nURI"; - foreach my $item (@pages) { - $pagedebut = $item->{'debut'}; - $pagefin = $item->{'fin'}; - my ($score, $id, $ark, $doi, $pii, $pmid, @pb) = traite(); - $label = "ETC"; - alerte(); - if ( $id ) { - $score *= 5.0; - my $nb = int($score); - my $note = "*" x $nb; - if ( $score - $nb > 0.5 ) { - $note .= "+"; - } - $note = "." if not $note; - $note .= "\x{A0}" x (5 - length($note)); - $score = sprintf("%.3f", $score); - if ( $score < 3.490 and $rdvfp{$id} ) { - $score .= $rdvfp{$id}; - } - if ( $score > $max or - ( $score =~ /^\d\.\d+\!\z/o and not - $max =~ /^\d\.\d+\!\z/o ) ) { - $max = $score; - } - if ( $alt{$id} ) { - if ( $alt{$id}{'score'} < $score or - ( $score =~ /^\d\.\d+\!\z/o and not - $alt{$id}{'score'} =~ /^\d\.\d+\!\z/o ) ) { - $alt{$id}{'score'} = $score; - $alt{$id}{'note'} = $note; - $alt{$id}{'debut'} = $pagedebut; - $alt{$id}{'fin'} = $pagefin; - $alt{$id}{'ark'} = $ark; - $alt{$id}{'doi'} = $doi; - $alt{$id}{'pii'} = $pii; - $alt{$id}{'pmid'} = $pmid; - } - } - else { - $alt{$id}{'score'} = $score; - $alt{$id}{'note'} = $note; - $alt{$id}{'debut'} = $pagedebut; - $alt{$id}{'fin'} = $pagefin; - $alt{$id}{'ark'} = $ark; - $alt{$id}{'doi'} = $doi; - $alt{$id}{'pii'} = $pii; - $alt{$id}{'pmid'} = $pmid; - } - } - else { - $alt{-1}{'score'} = 0.000; - $alt{-1}{'note'} = 0.000; - $alt{-1}{'debut'} = $pages[0]->{'debut'}; - $alt{-1}{'fin'} = $pages[0]->{'fin'}; - if ( $pb[0] == -1 ) { - $alt{-1}{'blanc'} = "\n"; - } - else { - $alt{-1}{'blanc'} = ""; - } - $alt{-1}{'ark'} = undef; - $alt{-1}{'doi'} = undef; - $alt{-1}{'pii'} = undef; - $alt{-1}{'pmid'} = undef; - } - } - foreach my $id (keys %alt) { - if ( $id eq "-1" and $max == 0.0 ) { - print "$alt{-1}{'blanc'}"; - print "0\t0.000\t$nivbib\t$num\t$titre\t$journal\t$livre\t$issn\t$isbn\t$date"; - print "\t$volume\t$fascicule\t$pagedebut\t$pagefin\t$nom1\t$prenom1\t$autres\t\t\t\t\t\n"; - delete $alt{-1}; - last; - } - elsif ( $alt{$id}{'score'} eq $max ) { - print "$alt{$id}{'note'}\t$alt{$id}{'score'}\t$nivbib\t$num\t$titre\t$journal"; - print "\t$livre\t$issn\t$isbn\t$date\t$volume\t$fascicule\t$pages[0]->{'debut'}"; - print "\t$pages[0]->{'fin'}\t$nom1\t$prenom1\t$autres\t$id\t$alt{$id}{'ark'}"; - print "\t$alt{$id}{'doi'}\t$alt{$id}{'pii'}\t$alt{$id}{'pmid'}\n"; - delete $alt{$id}; - last; - } - } - foreach my $id (keys %alt) { - if ( $alt{$id}{'score'} > 3.490 or $alt{$id}{'score'} =~ /^\d\.\d+\!\z/o ) { - print " --> \t$alt{$id}{'debut'}\t$alt{$id}{'fin'}\t$alt{$id}{'score'}\t$id"; - print "\t$alt{$id}{'ark'}\t$alt{$id}{'doi'}\t$alt{$id}{'pii'}\t$alt{$id}{'pmid'}\n"; - } - } - } - else { - $label = "\nURI"; - my ($score, $id, $ark, $doi, $pii, $pmid, @pb) = traite(); - alerte(); - if ( $id ) { - $score *= 5.0; - my $nb = int($score); - my $note = "*" x $nb; - if ( $score - $nb > 0.5 ) { - $note .= "+"; - } - $note = "." if not $note; - $note .= "\x{A0}" x (5 - length($note)); - $score = sprintf("%.3f", $score); - if ( $score < 3.490 and $rdvfp{$id} ) { - $score .= $rdvfp{$id}; - } - print "$note\t$score\t$nivbib\t$num\t$titre\t$journal\t$livre\t$issn\t$isbn\t$date"; - print "\t$volume\t$fascicule\t$pagedebut\t$pagefin\t$nom1\t$prenom1\t$autres\t$id"; - print "\t$ark\t$doi\t$pii\t$pmid\n"; - if ( @pb ) { - foreach my $pb (sort {$a <=> $b} @pb) { - print " ~~> \t$pb\n"; - } - } - } - else { - print "\n" if $pb[0] == -1; - print "0\t0.000\t$nivbib\t$num\t$titre\t$journal\t$livre\t$issn\t$isbn\t$date"; - print "\t$volume\t$fascicule\t$pagedebut\t$pagefin\t$nom1\t$prenom1\t$autres\t\t\t\t\t\n"; - } - } - } - else { - print "\n_\t-\t$nivbib\t$num\t$titre\t$journal\t$livre\t$issn\t$isbn\t$date"; - print "\t$volume\t$fascicule\t$pagedebut\t$pagefin\t$nom1\t$prenom1\t$autres\t\t\t\t\t\n"; - } - } - -if ( $verbeux ) { - my $moment = date(); - print STDERR " -> $moment : fin = $notice notices\n"; - } - - -exit 0; - - -sub usage -{ -print STDERR "\n$usage\n"; - -exit shift; -} - -sub date -{ -my @time = localtime(); - -my $jour = (qw(Dimanche Lundi Mardi Mercredi Jeudi Vendredi Samedi))[$time[6]]; -my $mois = (qw(Janvier Février Mars Avril Mai juin Juillet Août Septembre Octobre Novembre Décembre))[$time[4]]; -my $annee = $time[5] + 1900; - -my $moment = "$jour $time[3] $mois $annee "; -$moment .= sprintf("%02d:%02d:%02D", $time[2], $time[1], $time[0]); - -return $moment; -} - -sub alerte -{ -my $message = shift; - -if ( not $message ) { - print @alertes; - @alertes = (); - %alerte = (); - } -elsif ( not $alerte{$message} ) { - push(@alertes, "\t => $message !\n"); - $alerte{$message} ++; - } -} - -sub max -{ -my ($num1, $num2) = @_; - -if ( $num1 > $num2 ) { - return $num1; - } - -return $num2; -} - -sub get_hits -{ -my $query = shift; -$query =~ s/ /+/go; - -my $uri = "$url$query&$out&size=$size"; -$uri .= "&sid=tdm-alignement-pf"; - -my ($code, $json) = mon_get("$uri"); - -my $perl = undef; -my $suivant = undef; -my $total = undef; -my @hits = (); - -if ( defined $json ) { - eval { - $perl = decode_json $json; - }; - if ( $@ ) { - alerte("ERREUR CONVERSION JSON -> PERL"); - return(undef); - } - my %top = %{$perl}; - if ( $top{'_error'} ) { - alerte("ERREUR \"$top{'_error'}\""); - return(undef); - } - $total = $top{'total'}; - if ( $total > 0 ) { - if ( $total > 10000 ) { - alerte("RÉPONSE SUPÉRIEURE À 10 000"); - } - if ( defined $top{'nextPageURI'} ) { - $suivant = $top{'nextPageURI'}; - } - push(@hits, @{$top{'hits'}}); - - while($suivant) { - ($code, $json) = mon_get("$suivant"); - eval { - $perl = decode_json $json; - }; - if ( $@ ) { - alerte("ERREUR CONVERSION JSON -> PERL"); - return(undef); - } - %top = %{$perl}; - if ( defined $top{'nextPageURI'} ) { - $suivant = $top{'nextPageURI'}; - } - else { - $suivant = undef; - } - push(@hits, @{$top{'hits'}}); - } - } - - %top = ("total" => $total, "hits" => \@hits); - return \%top; - } -else { - return undef; - } -} - -sub get_total -{ -my $query = shift; -$query =~ s/ /+/go; - -my $uri = "$url$query&$out&size=0"; -$uri .= "&sid=tdm-alignement-pf"; - -my ($code, $json) = mon_get("$uri"); - -my $perl = undef; -my $total = undef; - -if ( defined $json ) { - eval { - $perl = decode_json $json; - }; - if ( $@ ) { - alerte("ERREUR CONVERSION JSON -> PERL"); - if ( $json =~ /\"total\": (d+),/o ) { - return($1); - } - else { - return(undef); - } - } - my %top = %{$perl}; - if ( $top{'_error'} ) { - alerte("ERREUR \"$top{'_error'}\""); - return(undef); - } - return($top{'total'}); - } -} - -sub mon_get -{ -my $cible = shift; - -my $requete = HTTP::Request->new(GET => "$cible"); - -my $reponse = $agent->request($requete); -my $code = $reponse->code; - -# Vérification de la réponse -if ($reponse->is_success) { - - - return ($code, $reponse->decoded_content); - } -else { - my $echec = 0; - my $message = $reponse->status_line; - if ( $message =~ /\b(read timeout|Proxy Error)\b/o and $echec < 10 ) { - $echec ++; - alerte("INTERRUPTION #$echec"); - sleep 2; - return mon_get($cible); - } - else { - alerte("ERREUR $code \"$message\""); - return($code, undef); - } - } -} - -sub traite -{ -my $id = undef; -my $ark = undef; -my $doi = undef; -my $pii = undef; -my $pmid = undef; -my $score = 0; - -my $query = ""; -my $altq = 0; -my @attendus = (); -my @mac = (); -my @tmp = (); -my %ok = (); - -%alerte = (); -%pages = (); -%pb = (); -%rdvfp = (); - -foreach my $item (@journaux) { - push(@tmp, "host.title:\"".propre($item)."\""); - } -foreach my $item (@issns) { - push(@tmp, "host.issn:\"$item\""); - push(@tmp, "host.eissn:\"$item\""); - push(@tmp, "serie.issn:\"$item\""); - push(@tmp, "serie.eissn:\"$item\""); - } -if ( @tmp ) { - if ( $#tmp == 0 ) { - $query .= $tmp[0]; - } - elsif ( $#tmp > 0 ) { - $query .= "(" . join(" OR ", @tmp) . ")"; - } - if ( defined $source{$query} ) { - if ( $source{$query} == 0 ) { - return(0, undef, undef, undef, undef, undef, -1); - } - } - else { - my $tmp = undef; - while( not defined $tmp ) { - $tmp = get_total($query); - if ( defined $tmp ) { - $source{$query} = $tmp; - if ( $tmp == 0 ) { - return(0, undef, undef, undef, undef, undef, -1); - } - } - } - } - } -else { - alerte("PAS DE REVUE OU ISSN"); - return(0, undef, undef, undef, undef, undef, -1); - } - -my %query = (); -$query{'journal'} = $query; - -if ( $date ) { - $query{'date'} = "publicationDate:$date OR copyrightDate:$date"; - $query{'date'} .= " OR host.publicationDate:$date OR host.copyrightDate:$date"; - $query{'date'} .= " OR serie.publicationDate:$date OR serie.copyrightDate:$date"; - } -if ( $volume ) { - if ( $volume =~ /^\d+\z/o ) { - $query{'volume'} = "host.volume:$volume"; - } - elsif ( $volume =~ m|^(\d+)[-/](\d+)\z|o ) { - my $inf = $1; - my $sup = $2; - $query{'volume'} = "host.volume.raw:\"$volume\""; - if ( $inf < $sup ) { - $query{'volume'} .= " OR host.volume:(".join(" ", ($inf .. $sup)).")"; - } - } - elsif ( $volume =~ /^(\d+)[A-Za-z]+\z/o ) { - $query{'volume'} = "host.volume.raw:\"$volume\" OR host.volume:$1"; - } - elsif ( $volume =~ /^[A-Za-z]+(\d+)\z/o ) { - $query{'volume'} = "host.volume.raw:\"$volume\" OR host.volume:$1"; - } - else { - my $tmp = propre($volume); - $query{'volume'} = "host.volume.raw:\"$tmp\""; - alerte("VOLUME \"$tmp\""); - } - } -if ( $fascicule ) { - if ( $fascicule =~ /^\d+\z/o ) { - $query{'fascicule'} = "host.issue:$fascicule"; - } - elsif ( $fascicule =~ m|^(\d+)[-/,](\d+)\z|o ) { - my $inf = $1; - my $sup = $2; - $query{'fascicule'} = "host.issue.raw:\"$fascicule\""; - if ( $inf < $sup ) { - $query{'fascicule'} .= " OR host.issue:(".join(" ", ($inf .. $sup)).")"; - } - } - elsif ( $fascicule =~ /^(\d+)([A-Za-z]+)\z/o ) { - $query{'fascicule'} = "host.issue.raw:(\"$1$2\" OR \"$2$1\") OR host.issue:$1"; - } - elsif ( $fascicule =~ /^([A-Za-z]+)(\d+)\z/o ) { - $query{'fascicule'} = "host.issue.raw:(\"$1$2\" OR \"$2$1\") OR host.issue:$2"; - } - elsif ( $fascicule =~ /^\d*[A-Za-z]+\d*[A-Za-z]*\z/o or - $fascicule =~ /^[A-Za-z]+-[A-Za-z]+\z/o ) { - $query{'fascicule'} = "host.issue.raw:\"$fascicule\""; - } - else { - my $tmp = propre($fascicule); - $query{'fascicule'} = "host.issue.raw:\"$tmp\""; - alerte("FASCICULE \"$tmp\""); - } - } - -if ( $nom1 ) { - my $auteurs = ""; - my $tmp = decode_entities($nom1); - my %tmp = ($tmp => 1); - my @tmp1 = (); - my @mots = $tmp =~ /(\p{IsAlpha}+)/go; - foreach my $mot (@mots) { - next if $mot =~ /^\p{IsAlpha}\z/o; - if ( $mot =~ /[^\0-\177]/ ) { - my $umot = unidecode($mot); - push(@tmp1, "\"".propre($mot)."\""); - push(@tmp1, "\"".propre($umot)."\""); - } - else { - push(@tmp1, "\"".propre($mot)."\""); - } - } - $auteurs = join(" OR ", @tmp1); - @tmp1 = (); - foreach my $item (@autres) { - my $nom = $item; - if ( $item =~ /^(.+?), / ) { - $nom = $1; - } - push @tmp1, decode_entities($nom); - } - my @tmp2 = grep {not $tmp{$_} ++;} @tmp1; - @tmp1 = ($auteurs); - foreach my $nom (@tmp2[0 .. 4]) { - next if not $nom; - next if $nom =~ /^\p{IsAlpha}\z/o; - if ( $nom =~ /[^\0-\177]/ ) { - $tmp = unidecode($nom); - push(@tmp1, "\"".propre($nom)."\" OR \"".propre($tmp)."\""); - } - else { - push(@tmp1, "\"".propre($nom)."\""); - } - } - $auteurs = join(" OR ", grep(/\S+/, @tmp1)); - if ( $auteurs ) { - $query{'auteur'} = "author.name:($auteurs)"; - } - } - -if ( $pagedebut ) { - @tmp = (); - my %tmp = (); - $pages{'first'}{$pagedebut} ++; - if ( $pagedebut =~ /^(.+)-\z/o ) { - $pagedebut = $1; - $pages{'first'}{$pagedebut} ++; - } - if ( $pagefin ) { - $pages{'last'}{$pagefin} ++; - if ( $pagedebut =~ /^\d+\z/o ) { - if ( $pagefin =~ /^\d+\z/o ) { - push(@{$tmp{'first'}}, "[$pagedebut TO $pagefin]"); - push(@{$tmp{'last'}}, "[$pagedebut TO $pagefin]"); - } - else { - push(@{$tmp{'first'}}, $pagedebut); - push(@{$tmp{'last.raw'}}, "\"$pagefin\""); - my $tmp = $pagefin; - if ( $fascicule and $pagefin =~ /^$fascicule[-.](.+)\z/ ) { - $tmp = $1; - $pages{'last'}{$tmp} ++; - } - elsif ( $pagefin =~ /^\w+[-.](.+)\z/ ) { - $tmp = $1; - $pages{'last'}{$tmp} ++; - } - if ( $tmp =~ /^\d+\z/o ) { - push(@{$tmp{'last'}}, $tmp); - $pages{'last'}{$pagefin} ++; - } - elsif ( $tmp =~ /^(\d+)([A-Za-z]+)\z/o ) { - push(@{$tmp{'last'}}, $1); - push(@{$tmp{'last.raw'}}, "\"$tmp\""); - push(@{$tmp{'last.raw'}}, "\"$2$1\""); - $pages{'last'}{"$1"} ++; - $pages{'last'}{"$2$1"} ++; - } - elsif ( $tmp =~ /^([A-Za-z]+)(\d+)\z/o ) { - push(@{$tmp{'last'}}, $2); - push(@{$tmp{'last.raw'}}, "\"$tmp\""); - push(@{$tmp{'last.raw'}}, "\"$2$1\""); - $pages{'last'}{"$2"} ++; - $pages{'last'}{"$2$1"} ++; - } - elsif ( $tmp ne $pagefin ) { - push(@{$tmp{'last.raw'}}, "\"$tmp\""); - } - } - } - else { - my $tmp = $pagedebut; - if ( $fascicule and $pagedebut =~ /^$fascicule[-.](.+)\z/ ) { - $tmp = $1; - # push(@{$tmp{'first.raw'}}, "\"$tmp\""); - } - elsif ( $pagedebut =~ /^\w+[-.](.+)\z/ ) { - $tmp = $1; - # push(@{$tmp{'first.raw'}}, "\"$tmp\""); - } - if ( $tmp =~ /^\d+\z/o ) { - push(@{$tmp{'first'}}, $tmp); - $pages{'first'}{$tmp} ++; - } - elsif ( $tmp =~ /^(\d+)([A-Za-z]+)\z/o ) { - push(@{$tmp{'first'}}, $1); - push(@{$tmp{'first.raw'}}, "\"$tmp\""); - push(@{$tmp{'first.raw'}}, "\"$2$1\""); - $pages{'first'}{"$1"} ++; - $pages{'first'}{"$2$1"} ++; - } - elsif ( $tmp =~ /^([A-Za-z]+)(\d+)\z/o ) { - push(@{$tmp{'first'}}, $2); - push(@{$tmp{'first.raw'}}, "\"$tmp\""); - push(@{$tmp{'first.raw'}}, "\"$2$1\""); - $pages{'first'}{"$2"} ++; - $pages{'first'}{"$2$1"} ++; - } - else { - push(@{$tmp{'first.raw'}}, "\"$tmp\""); - $pages{'first'}{$tmp} ++; - } - $tmp = $pagefin; - if ( $fascicule and $pagefin =~ /^$fascicule[-.](.+)\z/ ) { - $tmp = $1; - push(@{$tmp{'last.raw'}}, "\"$tmp\""); - } - elsif ( $pagefin =~ /^\w+[-.](.+)\z/ ) { - $tmp = $1; - push(@{$tmp{'last.raw'}}, "\"$tmp\""); - } - $pages{'last'}{$tmp} ++; - if ( $tmp =~ /^\d+\z/o ) { - push(@{$tmp{'last'}}, $tmp); - } - elsif ( $tmp =~ /^(\d+)([A-Za-z]+)\z/o ) { - push(@{$tmp{'last'}}, $1); - push(@{$tmp{'last.raw'}}, "\"$tmp\""); - push(@{$tmp{'last.raw'}}, "\"$2$1\""); - $pages{'last'}{"$1"} ++; - $pages{'last'}{"$2$1"} ++; - } - elsif ( $tmp =~ /^([A-Za-z]+)(\d+)\z/o ) { - push(@{$tmp{'last'}}, $2); - push(@{$tmp{'last.raw'}}, "\"$tmp\""); - push(@{$tmp{'last.raw'}}, "\"$2$1\""); - $pages{'last'}{"$2"} ++; - $pages{'last'}{"$2$1"} ++; - } - else { - push(@{$tmp{'last.raw'}}, "\"$tmp\""); - } - } - } - else { - if ( $pagedebut =~ /^\d+\z/o ) { - push(@{$tmp{'first'}}, "\"$pagedebut\""); - } - else { - my $tmp = $pagedebut; - if ( $fascicule and $pagedebut =~ /^$fascicule[-.](.+)\z/ ) { - $tmp = $1; - push(@{$tmp{'first.raw'}}, "\"$tmp\""); - } - elsif ( $pagedebut =~ /^\w+[-.](.+)\z/ ) { - $tmp = $1; - push(@{$tmp{'first.raw'}}, "\"$tmp\""); - } - $pages{'first'}{$tmp} ++; - if ( $tmp =~ /^\d+\z/o ) { - push(@{$tmp{'first'}}, $tmp); - } - elsif ( $tmp =~ /^(\d+)([A-Za-z]+)\z/o ) { - push(@{$tmp{'first'}}, $1); - push(@{$tmp{'first.raw'}}, "\"$tmp\""); - push(@{$tmp{'first.raw'}}, "\"$2$1\""); - $pages{'first'}{"$1"} ++; - $pages{'first'}{"$2$1"} ++; - } - elsif ( $tmp =~ /^([A-Za-z]+)(\d+)\z/o ) { - push(@{$tmp{'first'}}, $2); - push(@{$tmp{'first.raw'}}, "\"$tmp\""); - push(@{$tmp{'first.raw'}}, "\"$2$1\""); - $pages{'first'}{"$2"} ++; - $pages{'first'}{"$2$1"} ++; - } - else { - push(@{$tmp{'first.raw'}}, "\"$tmp\""); - } - } - } - foreach my $tmp (sort keys %tmp) { - my @items = @{$tmp{$tmp}}; - next if $#items < 0; - if ( $#items == 0 ) { - push(@tmp, "host.pages.$tmp:$items[0]"); - } - else { - push(@tmp, "host.pages.$tmp:(".join(" OR ", @items).")"); - } - } - if ( @tmp ) { - $query{'page'} = join(" OR ", @tmp); - } - } - -if ( $titre ) { - @tmp = grep(!/^(and|not|or)\z/io, ($titre =~ /(\w+)/go)); - my @mots = sort {length($b) <=> length($a) or $a cmp $b} @tmp; - splice (@mots, 3); - $query{'titre'} = "title:(" . join(" ", @mots) . ")"; - } - -# Composition de la requête -if ( $query{'date'} or $query{'volume'} or $query{'fascicule'} ) { - $query .= " AND (".join(" OR ", grep {defined $_;} $query{'date'}, - $query{'volume'}, $query{'fascicule'}).")"; - } -$query{'base'} = $query; -if ( $query{'auteur'} or $query{'page'} ) { - $query .= " AND (".join(" OR ", grep {defined $_;} $query{'auteur'}, - $query{'page'}).")"; - } -else { - $query .= " AND " . $query{'titre'}; - $query{'base'} = undef; - } - -# Envoi de la requête -print "$label : \"$url$query&$out\"\n"; - -my $perl = get_hits($query); -if ( defined $perl ) { - %modifs = (); - my %top = %{$perl}; - printf "\t => %d\n", $top{'total'}; - if ( $top{'total'} >= 1 ) { - @attendus = (); - if ( $nom1 ) { - push @attendus, decode_entities($nom1) ; - } - foreach my $item (@autres) { - my $nom = $item; - if ( $item =~ /^(.+?), / ) { - $nom = $1; - } - push @attendus, decode_entities($nom); - } - @mac = (); - my $mac = 0; - foreach my $item (@attendus) { - if ( $item =~ /\bma?c ?(\w+)/oi ) { - my $canon = "$`Mc$1$'"; - $mac ++ if $canon ne $item; - push(@mac, $canon); - } - else { - push(@mac, $item); - } - } - if ( $mac == 0 ) { - @mac = (); - } - my @hits = @{$top{'hits'}}; - foreach my $hit (@hits) { - my ($valeur, $idCourant, $arkCourant, $refId, $ok) = evalue($hit, \@attendus, \@mac); - if ( $valeur > $score ) { - $score = $valeur; - $id = $idCourant; - $ark = $arkCourant; - $doi = defined $refId->{'doi'} ? $refId->{'doi'} : undef; - $pii = defined $refId->{'pii'} ? $refId->{'pii'} : undef; - $pmid = defined $refId->{'pmid'} ? $refId->{'pmid'} : undef; - print STDERR "\t=> score = $score\n\n" if $debug; - } - elsif ( $debug ) { - print STDERR "\n"; - } - if ( $ok =~ /D[VIFvif]+/o ) { - $ok{$ok} ++; - } - last if $score == 1.000; - } - } - } -else { - alerte("ERREUR"); - } - -if ( $score == 0 and $query{'base'} and $query{'titre'} ) { - alerte(); - $query = $query{'base'}; - $query .= " AND " . $query{'titre'}; - # Envoi de la requête - print "RAC : \"$url$query&$out\"\n"; - - my $perl = get_hits($query); - if ( defined $perl ) { - my %top = %{$perl}; - printf "\t => %d\n", $top{'total'}; - if ( $top{'total'} >= 1 ) { - my @hits = @{$top{'hits'}}; - foreach my $hit (@hits) { - my ($valeur, $idCourant, $arkCourant, $refId, $ok) = evalue($hit, \@attendus, \@mac); - if ( $valeur > $score ) { - $score = $valeur; - $id = $idCourant; - $ark = $arkCourant; - $doi = defined $refId->{'doi'} ? $refId->{'doi'} : undef; - $pii = defined $refId->{'pii'} ? $refId->{'pii'} : undef; - $pmid = defined $refId->{'pmid'} ? $refId->{'pmid'} : undef; - print STDERR "\t=> score = $score\n\n" if $debug; - } - elsif ( $debug ) { - print STDERR "\n"; - } - if ( $ok =~ /D[VIFvif]+/o ) { - $ok{$ok} ++; - } - last if $score == 1.000; - } - } - } - else { - alerte("ERREUR"); - } - } - -my @liste = groupe($pb{$id}) if not @pages; - -return ($score, $id, $ark, $doi, $pii, $pmid, @liste); -} - -sub evalue -{ -my $hit = shift; -my $ref = shift; -my @attendus = @{$ref}; -$ref = shift; -my @mac1 = @{$ref}; - -my $proche = ""; -my $score = 0; -my $succes = 0; -my $total = 0; - -my %hit = %{$hit}; -my $id = $hit{'id'}; -my $ark = $hit{'arkIstex'}; -my %id = (); - -$id{'doi'} = defined $hit{'doi'} ? $hit{'doi'}->[0] : 'N/A'; -$id{'pii'} = defined $hit{'pii'} ? $hit{'pii'}->[0] : undef; -$id{'pmid'} = defined $hit{'pmid'} ? $hit{'pmid'}->[0] : undef; - -my %host = (); -if ( $hit{'host'} ) { - %host = %{$hit{'host'}}; - } -my %serie = (); -if ( $hit{'serie'} ) { - %serie = %{$hit{'serie'}}; - } -# Test de l'ISSN -my %bib = (); -my @nums = (); -if ( $host{'issn'} ) { - @nums = @{$host{'issn'}}; - } -if ( @nums and @issns ) { - $total ++; - my $trouve = 0; - foreach my $issn1 (@nums) { - foreach my $issn2 (@issns) { - if ( $issn1 eq $issn2 or - uc($issn1) eq uc($issn2) ) { - $trouve = $issn1; - } - } - } - if ( $trouve ) { - $succes ++ ; - $bib{'issn'} = $trouve; - print STDERR "ISSN : +1\n" if $debug; - } - elsif ( $debug ) { - print STDERR "ISSN : 0\n" if $debug; - } - } -elsif ( $debug ) { - print STDERR "ISSN : N.A.\n" if $debug; - } -my $revue = $host{'title'}; -my $serie = defined $serie{'title'} ? $serie{'title'} : undef; -# Test du nom de la revue -if ( @journaux and ( $revue or $serie ) ) { - $total ++; - my $trouve = 0; - if ( $revue ) { - $trouve = revue($revue, @journaux); - if ( $trouve ) { - $succes ++ ; - $bib{'revue'} ++; - } - } - if ( $serie and not $trouve ) { - $trouve = revue($serie, @journaux); - if ( $trouve ) { - $succes ++ ; - $bib{'serie'} ++; - } - } - if ( $trouve ) { - print STDERR "Revue : +1\n" if $debug; - } - else { - print STDERR "Revue : 0\n" if $debug; - } - } -elsif ( $debug ) { - print STDERR "Revue : N.A.\n" if $debug; - } -# Récupération de la date -$bib{'publicationDate'} = $hit{'publicationDate'} ? $hit{'publicationDate'} : undef; -$bib{'copyrightDate'} = $hit{'copyrightDate'} ? $hit{'copyrightDate'} : undef; -$bib{'host.publicationDate'} = $host{'publicationDate'} ? $host{'publicationDate'} : undef; -$bib{'host.copyrightDate'} = $host{'copyrightDate'} ? $host{'copyrightDate'} : undef; -$bib{'serie.publicationDate'} = $serie{'publicationDate'} ? $serie{'publicationDate'} : undef; -$bib{'serie.copyrightDate'} = $serie{'copyrightDate'} ? $serie{'copyrightDate'} : undef; -if ( defined $bib{'publicationDate'} and - $bib{'publicationDate'} eq $date ) { - $bib{'date'} ++; - } -if ( defined $bib{'copyrightDate'} and - $bib{'copyrightDate'} eq $date ) { - $bib{'date'} ++; - } -if ( defined $bib{'host.publicationDate'} and - $bib{'host.publicationDate'} eq $date ) { - $bib{'date'} ++; - } -if ( defined $bib{'host.copyrightDate'} and - $bib{'host.copyrightDate'} eq $date ) { - $bib{'date'} ++; - } -if ( defined $bib{'serie.publicationDate'} and - $bib{'serie.publicationDate'} eq $date ) { - $bib{'date'} ++; - } -if ( defined $bib{'serie.copyrightDate'} and - $bib{'serie.copyrightDate'} eq $date ) { - $bib{'date'} ++; - } -if ( $bib{'date'} ) { - $proche .= "D"; - } -# Test du volume -my $vol = $host{'volume'}; -my $masque = ""; -if ( $vol and $volume ) { - $total ++; - $proche .= "v"; - if ( $vol eq $volume or biniou($vol, $volume, "VOLUME") ) { - $succes ++; - $bib{'volume'} ++; - $proche =~ s/v/V/o; - print "Volume : +1\n" if $debug; - } - elsif ( unidecode($vol) eq unidecode($volume) ) { - $succes ++; - $bib{'volume'} ++; - $proche =~ s/v/V/o; - print "Volume : +1\n" if $debug; - } - elsif ( $debug ) { - print "Volume : 0\n" if $debug; - } - } -elsif ( $vol and $fascicule ) { - $total ++; - $proche .= "i"; - if ( $vol eq $fascicule or biniou($vol, $fascicule, "VOLUME/FASCICULE") ) { - $succes ++; - $bib{'volume'} ++; - $proche =~ s/i/I/o; - $masque = $fascicule; - $fascicule = ""; - alerte("VOLUME = ISSUE"); - print "Volume : +1\n" if $debug; - } - elsif ( unidecode($vol) eq unidecode($fascicule) ) { - $succes ++; - $bib{'volume'} ++; - $proche =~ s/i/I/o; - $masque = $fascicule; - $fascicule = ""; - alerte("VOLUME = ISSUE"); - print "Volume : +1\n" if $debug; - } - elsif ( $debug ) { - print "Volume : 0\n" if $debug; - } - } -elsif ( $debug ) { - print STDERR "Volume : N.A.\n"; - } -# Test du numéro de fascicule -my $issue = $host{'issue'}; -if ( $issue and $fascicule ) { - $total ++; - $proche .= "f"; - my $trouve = 0; - if ( $issue eq $fascicule or biniou($issue, $fascicule, "FASCICULE") ) { - $trouve ++; - } - elsif ( unidecode($issue) eq unidecode($fascicule) ) { - $trouve ++; - } - if ( not $trouve ) { - if ( $fascicule =~ /^\p{IsAlpha}+(\d+)\z/ ) { - my $tmp = $1; - $trouve ++ if $issue eq $tmp; - } - elsif ( $fascicule =~ /^(\d+)\p{IsAlpha}+\z/ ) { - my $tmp = $1; - $trouve ++ if $issue eq $tmp; - } - } - if ( $trouve ) { - $succes ++; - $proche =~ s/f/F/o; - $bib{'fascicule'} ++; - print "Numéro : +1\n" if $debug; - } - elsif ( $debug ) { - print "Numéro : 0\n" if $debug; - } - } -elsif ( $debug ) { - print STDERR "Numéro : N.A.\n"; - } -if ( $masque and not $fascicule ) { - $fascicule = $masque; - $masque = ""; - } - -my $okdebut = undef; -my $okfin = undef; -my $first = $host{'pages'}{'first'}; -# Test du numéro de première page -if ( $first and $pagedebut ) { - $total ++; - my @tmp = (); - my $safe = $first; - $safe =~ s/(\W)/\\$1/go; - if ( defined $pages{'first'} ) { - @tmp = sort keys %{$pages{'first'}}; - } - if ( $first eq $pagedebut ) { - $succes ++; - $bib{'pagedebut'} ++; - $okdebut = $pagedebut; - print STDERR "Page début : +1\n" if $debug; - } - elsif ( grep(/^$safe\z/, @tmp) > 0 ) { - $succes ++; - $bib{'pagedebut'} ++; - $okdebut = (grep(/^$first\z/, @tmp))[0]; - print STDERR "Page début : +1\n" if $debug; - } - elsif ( $debug ) { - print STDERR "Page début : 0\n"; - } - } -elsif ( $debug ) { - print STDERR "Page début : N.A.\n"; - } -my $last = $host{'pages'}{'last'}; -# Test du numéro de dernière page -if ( $last and $pagefin ) { - $total ++; - my @tmp = (); - my $safe = $last; - $safe =~ s/(\W)/\\$1/go; - if ( defined $pages{'last'} ) { - @tmp = sort keys %{$pages{'last'}}; - } - if ( $last eq $pagefin ) { - $succes ++; - $bib{'pagefin'} ++; - $okfin = $pagefin; - print STDERR "Page fin : +1\n" if $debug; - } - elsif ( grep(/^$safe\z/, @tmp) > 0 ) { - $succes ++; - $bib{'pagefin'} ++; - $okfin = (grep(/^$last\z/, @tmp))[0]; - print STDERR "Page fin : +1\n" if $debug; - } - elsif ( $debug ) { - print STDERR "Page fin : 0\n"; - } - } -elsif ( $debug ) { - print STDERR "Page fin : N.A.\n"; - } - -# Indication que les données bibliographiques -# sont a priori correctes -if ( ( $bib{'revue'} or $bib{'issn'} ) and - ( $bib{'volume'} or $bib{'fascicule'} ) and - $bib{'date'} and $okdebut and $okfin ) { - $rdvfp{$id} = "!"; - } - -# Test du pb des notices Pascal (et Francis ?) -# groupant plusieurs articles -$pb{$id} = undef; -if ( $first and $pagedebut and $last and $pagefin ) { - if ( ( $first > $pagedebut and $first <= $pagefin ) or - ( $last < $pagefin and $last >= $pagedebut ) ) { - my %tmp = (); - if ( ( $bib{'revue'} or $bib{'issn'} ) and - ( $bib{'volume'} or $bib{'fascicule'} or - $bib{'publicationDate'} or $bib{'copyrightDate'} or - $bib{'host.publicationDate'} or $bib{'host.copyrightDate'} or - $bib{'serie.publicationDate'} or $bib{'serie.copyrightDate'} ) ) { - $tmp{'revue'} = $revue if $revue; - $tmp{'serie'} = $serie if $serie; - $tmp{'issn'} = $bib{'issn'} if $bib{'issn'}; - $tmp{'volume'} = $vol if $vol; - $tmp{'fascicule'} = $issue if $issue; - $tmp{'publicationDate'} = $bib{'publicationDate'}; - $tmp{'copyrightDate'} = $bib{'copyrightDate'}; - $tmp{'host.publicationDate'} = $bib{'host.publicationDate'}; - $tmp{'host.copyrightDate'} = $bib{'host.copyrightDate'}; - $tmp{'serie.publicationDate'} = $bib{'serie.publicationDate'}; - $tmp{'serie.copyrightDate'} = $bib{'serie.copyrightDate'}; - $tmp{'pagedebut'} = $pagedebut; - $tmp{'pagefin'} = $pagefin; - $pb{$id} = \%tmp; - } - } - } -# Le test devrait être plus circonstancié !!! -# Seulement si on a assez d'éléments pour être sûr !!! -my $bib = 0; -if ( $total >= 4 and $total == $succes ) { - if ( ($bib{'revue'} or $bib{'issn'}) and - ($bib{'volume'} or $bib{'fascicule'}) and - ($bib{'pagedebut'} or $bib{'pagefin'}) ) { - $bib = 1; - } - } -my $poids = 2; -# Commenté pour l'instant en attendant de voir -# si c'est aussi futé que je le croyais ! -# if ( $total <= 4 ) { -# $poids = 1; -# } -# if ( not $bib ) { -# $total = max(4, $total + 1); -# } -if ( $debug ) { - print STDERR "\n\t=> total = $total\n"; - print STDERR "\t=> bib = $bib\n"; - print STDERR "\t=> poids = $poids\n\n"; - } -# Test du titre -my $title = $hit{'title'}; -if ( $title and $titre ) { - $total ++; - my $trouve = 0; - my $pot = 0; - if ( $titre =~ /^Pro and con\s*:\s*/o and - $title =~ /^(Pro|Con)\s*:/o ) { - my ($tmp1) = $titre =~ /^Pro and con\s*:\s*(\S.+)/o; - my ($tmp2) = $title =~ /^(?:Pro|Con)\s*:\s*(\S.+)/o; - if ( $pot = titre($tmp2, $tmp1, $bib) ) { - $trouve ++; - } - } - elsif ( $pot = titre($title, $titre, $bib) ) { - $trouve ++; - } - if ( not $trouve and $titre =~ / [IVXLCDM]+ *:/o ) { - if ( $pot = romain($title, $titre) ) { - $trouve ++; - } - } - if ( $trouve ) { - $succes += $pot; - print STDERR "Titre : +$pot\n" if $debug; - } - elsif ( $debug ) { - print STDERR "Titre : 0\n"; - } - } -elsif ( $debug ) { - print STDERR "Titre : N.A.\n"; - } -# -my @auteurs = (); -if ( $hit{'author'} ) { - @auteurs = @{$hit{'author'}}; - } -# Test des noms d'auteur -my @mac2 = (); -my $mac2 = 0; -if ( ( @auteurs and not @attendus ) or - ( @attendus and not @auteurs ) ) { - $total += 1; - } -elsif ( @auteurs and @attendus ) { - my $ld = 0; - my $trouve = 0; - my @names = (); - foreach my $auteur (@auteurs) { - my %auteur = %{$auteur}; - next unless $auteur{'name'}; # Est-ce possible et si oui, que fait-on ? - my $name = $auteur{'name'}; - if ( $name =~ /\bma?c ?(\w+)/oi ) { - my $canon = "$`Mc$1$'"; - $mac2 ++ if $canon ne $name; - push(@mac2, $canon); - } - else { - push(@mac2, $name); - } - push(@names, $name); - } - if ( $mac2 == 0 ) { - @mac2 = (); - } - ($trouve, $ld) = ld_au(\@attendus, \@names); - if ( $ld and (@mac1 or @mac2) ) { - my $trouve2 = undef; - my $ld2 = undef; - if ( @mac1 and @mac2 ) { - ($trouve2, $ld2) = ld_au(\@mac1, \@mac2); - } - elsif ( @mac1 ) { - ($trouve2, $ld2) = ld_au(\@mac1, \@names); - } - else { - ($trouve2, $ld2) = ld_au(\@attendus, \@mac2); - } - if ( $trouve2 >= $trouve and $ld2 <= $ld ) { - $trouve = $trouve2; - $ld = $ld2; - alerte("CORRECTION MAC"); - } - } - if ( $trouve == ($#attendus + 1) and $ld and $bib ) { - alerte("RATTRAPAGE"); - $ld = 0; - } - my $ild = 1 - ($ld / ($#auteurs + $#attendus + 2)); - $total += $poids; - if ( $#auteurs == $#attendus ) { - $poids = $poids * $trouve * $ild / ($#auteurs + 1); -# $succes += $poids * $trouve * $ild / ($#auteurs + 1); - $succes += $poids; - } - elsif ( $#auteurs > $#attendus ) { - if ( $#attendus > 34 and $#auteurs > 59 and $#auteurs - $#attendus > 2 ) { - $poids = $poids * $trouve * $ild / ($#attendus + 1); - } - else { - $poids = $poids * $trouve * $ild / ($#auteurs + 1); - } - $succes += $poids; - } - else { - $poids = $poids * $trouve * $ild / ($#attendus + 1); - $succes += $poids; - } - print STDERR "Auteurs : +$poids\n\n" if $debug; - } -elsif ( $debug ) { - print STDERR "Auteurs : N.A.\n\n"; - } -print STDERR "\t=> total = $total\n" if $debug; -if ( $total ) { - $score = $succes/$total; - print STDERR "\t=> succes = $succes\n" if $debug; - print STDERR "\t=> score = $score\n\n" if $debug; - return($score, $id, $ark, \%id, $proche); - } -else { - alerte("TOTAL NUL"); - return(0, $id, $ark, \%id, $proche); - } -} - -sub propre -{ -my $chaine = shift; -my $tmp1 = ""; -my $tmp2 = ""; - -# Conversion vers UTF-8 et échappement des caractères réservés -$tmp1 = decode_entities($chaine); -$tmp1 =~ s#([+&|!(){}^"~*?:\/])#\\$1#go; -$tmp1 =~ s#([][])#\\$1#go; - -# URLencodage -$tmp2 = uri_encode($tmp1); -$tmp2 =~ s/%20/ /go; -$tmp2 =~ s/&/%26/go; - -return $tmp2; -} - -sub titre -{ -my ($t1, $t2, $sb) = @_; - -if ( $t1 eq $t2 or - lc($t1) eq lc($t2) or - lc(unidecode($t1)) eq lc(unidecode($t2))) { - return 1; - } - -$t2 =~ s|||go; - -my $tmp1 = lc(join(" ", ($t1 =~ /(\w+)/go))); -my $tmp2 = lc(join(" ", ($t2 =~ /(\w+)/go))); - -if ( $tmp1 eq $tmp2 ) { - return 1; - } -elsif ( unidecode($tmp1) eq unidecode($tmp2) ) { - return 1; - } -else { - $tmp1 = unidecode($tmp1); - $tmp2 = unidecode($tmp2); - my $ld = levenshtein_damereau($tmp1, $tmp2); - if ( $ld == 1 and length($tmp2) > 20 ) { - return 1; - } - elsif ( $ld == 2 and length($tmp2) > 40 ) { - return 1; - } - } - -if ( $sb ) { - if ( $tmp1 =~ /\b$tmp2\b/ or $tmp2 =~ /\b$tmp1\b/ ) { - return 0.5; - } - } - -if ( $t1 =~ /: /o or $t2 =~ /: /o ) { - my ($tmp1) = $t1 =~ /^(.+?)\s*: /o; - my ($tmp2) = $t2 =~ /^(.+?)\s*: /o; - if ( $tmp1 eq $tmp2 ) { - alerte("TITRE RÉDUIT 1"); - return 1; - } - else { - $tmp1 = lc(join(" ", ($tmp1 =~ /(\w+)/go))); - $tmp2 = lc(join(" ", ($tmp2 =~ /(\w+)/go))); - if ( $tmp1 eq $tmp2 ) { - alerte("TITRE RÉDUIT 2"); - return 1; - } - elsif ( unidecode($tmp1) eq unidecode($tmp2) ) { - alerte("TITRE RÉDUIT 3"); - return 1; - } - } - } - -## Test partie de titre -($tmp1 = $t1) =~ s/([^\w ])/\\$1/go; -($tmp2 = $t2) =~ s/([^\w ])/\\$1/go; -if ( length($t1) > length($t2) ) { - if ( $tmp1 =~ /^$tmp2\. .+/i ) { - alerte("TITRE RÉDUIT 4"); - return 0.5; - } - } -elsif ( length($t1) < length($t2) ) { - if ( $tmp2 =~ /^$tmp1\. .+/i ) { - alerte("TITRE RÉDUIT 4"); - return 0.5; - } - } - -return 0; -} - -sub ld_au # Levenshtein-Damereau adapté aux listes d'auteurs -{ -my ($ref1, $ref2) = @_; - -my @liste1 = @{$ref1}; -my @liste2 = @{$ref2}; - -my $len1 = $#liste1 + 1; -my $len2 = $#liste2 + 1; - -return $len2 if $len1 == 0; -return $len1 if $len2 == 0; - -my %mat = (); - -for ( my $i = 0 ; $i <= $len1 ; $i ++ ) { - for ( my $j = 0 ; $j <= $len2 ; $j ++ ) { - $mat{$i}{$j} = 0; - $mat{0}{$j} = $j; - } - $mat{$i}{0} = $i; - } - -my $cost = 0; -my %trouve = (); - -for ( my $i = 1 ; $i <= $len1 ; $i ++ ) { - my $trouve = 0; - for ( my $j = 1 ; $j <= $len2 ; $j ++ ) { - $cost = 1 - compare($liste1[$i-1], $liste2[$j-1]); - $trouve ++ if $cost == 0; - $mat{$i}{$j} = min ([$mat{$i-1}{$j} + 1, - $mat{$i}{$j-1} + 1, - $mat{$i-1}{$j-1} + $cost]); - if ( $i > 1 and $j > 1 and - compare($liste1[$i - 1], $liste2[$j - 2]) and - compare($liste1[$i - 2], $liste2[$j - 1]) ) { - $mat{$i}{$j} = min ([$mat{$i}{$j}, - $mat{$i-2}{$j-2} + $cost]); - } - } - $trouve{$liste1[$i-1]} ++ if $trouve; - } - -my $trouve = 0; -foreach my $item (keys %trouve) { - $trouve += $trouve{$item}; - } - -# print "\t -> $trouve ; $mat{$len1}{$len2}\n"; -if ( $len1 > 35 and $len2 > 60 and $len2 - $len1 > 2 ) { - return ($trouve, $mat{$len1}{$len1}); - } -else { - return ($trouve, $mat{$len1}{$len2}); - } -} - -sub levenshtein_damereau -{ -my ($s1, $s2) = @_; - -my $len1 = length $s1; -my $len2 = length $s2; - -return $len2 if $len1 == 0; -return $len1 if $len2 == 0; - -my %mat = (); - -for ( my $i = 0 ; $i <= $len1 ; $i ++ ) { - for ( my $j = 0 ; $j <= $len2 ; $j ++ ) { - $mat{$i}{$j} = 0; - $mat{0}{$j} = $j; - } - $mat{$i}{0} = $i; - } - -my @ar1 = split(//, $s1); -my @ar2 = split(//, $s2); - -my $cost = 0; - -for ( my $i = 1 ; $i <= $len1 ; $i ++ ) { - for ( my $j = 1 ; $j <= $len2 ; $j ++ ) { - $cost = $ar1[$i-1] eq $ar2[$j-1] ? 0 : 1; - $mat{$i}{$j} = min ([$mat{$i-1}{$j} + 1, - $mat{$i}{$j-1} + 1, - $mat{$i-1}{$j-1} + $cost]); - if ( $i > 1 and $j > 1 and - $ar1[$i - 1] eq $ar2[$j - 2] and - $ar1[$i - 2] eq $ar2[$j - 1] ) { - $mat{$i}{$j} = min ([$mat{$i}{$j}, $mat{$i-2}{$j-2} + $cost]); - } - } - } - -return $mat{$len1}{$len2}; -} - -sub min -{ -my @liste = @{$_[0]}; -my $min = shift @liste; - -foreach my $i (@liste) { - $min = $i if $i < $min; - } - -return $min; -} - -sub romain -{ -my ($t2, $t1) = @_; - -my $p2 = join(" ", ($t2 =~ /(\p{IsAlnum}+)/go)); - -while( $t1 =~ / ([IVXLCDM]+) *: */go ) { - my $avant = $`; - my $apres = $'; - my $numR = $1; - (my $tav = $avant) =~ s/([^\p{IsAlnum} ])/\\$1/go; - (my $tap = $apres) =~ s/([^\p{IsAlnum} ])/\\$1/go; - my $val = $convert->arabic($numR); - if ( $t2 =~ /^$tav +(\p{IsAlnum}+ )?($val|$numR) *[:.] *$tap\z/i ) { - return 1; - } - else { - my $pav = join(" ", ($avant =~ /(\p{IsAlnum}+)/go)); - my $pap = join(" ", ($apres =~ /(\p{IsAlnum}+)/go)); - if ( $p2 =~ /^$pav +(\p{IsAlnum}+ )?($val|$numR) *$pap\z/i ) { - return 1; - } - elsif ( $p2 =~ /^$pav +(\p{IsAlnum}+ )?\p{IsAlnum}+ *$pap\z/i ) { - return 0.5; - } - } - } - -return 0; -} - -sub compare -{ -my ($attendu, $name) = @_; - -(my $safe = $attendu) =~ s/([^\p{IsAlnum} ])/\\$1/go; - -if ( $name =~ /\b$safe\b/i ) { -# print "\t - $attendu <=> $name : 1\n"; - return 1; - } - -$name =~ s/[\x{60}\x{B4}\x{B8}]//go; - -my $tmp1 = lc(unidecode($name)); -my $tmp2 = lc(unidecode($attendu)); -($safe = $tmp2) =~ s/([^\p{IsAlnum} ])/\\$1/go; -if ( $tmp1 =~ /\b$safe\b/ ) { -# print "\t - $attendu <=> $name : 1\n"; - return 1; - } - -my @tmp1 = split(/\s+/o, $tmp1); -my $premier = shift @tmp1; -$tmp1 = join(" ", @tmp1, $premier); -if ( $tmp1 =~ /\b$safe\b/ ) { - return 1; - } -unshift @tmp1, $premier; -my $dernier = pop @tmp1; -$tmp1 = join(" ", $dernier, @tmp1); -if ( $tmp1 =~ /\b$safe\b/ ) { - return 1; - } - -# print "\t - $attendu <=> $name : 0\n"; -return 0; -} - -sub biniou -{ -my ($val1, $val2, $champ) = @_; - -if ( $val1 =~ /^\d+\z/o ) { - if ( $val2 =~ /^(\d+)[-\x{2010}-\x{2015}\x{2212}](\d+)\z/o ) { - my $inf = $1; - my $sup = $2; - if ( $inf < $sup and $val1 >= $inf and $val1 <= $sup ) { - return 1; - } - } - } -elsif ( $val1 =~ m|^(\d+)[-\x{2010}-\x{2015}\x{2212}/](\d+)\z|o ) { - my $inf = $1; - my $sup = $2; - if ( $val2 =~ /^\d+\z/o ) { - if ( $inf < $sup and $val2 >= $inf and $val2 <= $sup ) { - return 1; - } - } - elsif ( $val2 =~ m|^(\d+)[-\x{2010}-\x{2015}\x{2212}/](\d+)\z|o ) { - my $inf2 = $1; - my $sup2 = $2; - if ( $inf == $inf2 and $sup == $sup2 ) { - return 1; - } - } - } -elsif ( $val1 =~ /^([A-Za-z]+)(\d+)\z/o ) { - my $vl = $1; - my $vn = $2; - if ( $val2 =~ /^([A-Za-z])(\d+)[-\x{2010}-\x{2015}\x{2212}]([A-Za-z])(\d+)\z/o ) { - my $infl = $1; - my $infn = $2; - my $supl = $3; - my $supn = $4; - if ( $infl eq $supl ) { - if ( $vl eq $infl and $vn >= $infn and $vn <= $supl ) { - return 1; - } - } - elsif ( $infl lt $supl ) { - if ( $vl eq $infl and $vn >= $infn ) { - return 1; - } - if ( $vl eq $supl and $vn <= $supn ) { - return 1; - } - if ( $vl gt $infl and $vl lt $supl ) { - return 1 - } - } - else { - alerte("FORMAT $champ ISTEX BIZARRE \"$val2\"") - } - } - } -elsif ( $val1 =~ /^([A-Za-z])(\d+)[-\x{2010}-\x{2015}\x{2212}]([A-Za-z])(\d+)\z/o ) { - my $infl = $1; - my $infn = $2; - my $supl = $3; - my $supn = $4; - if ( $val2 =~ /^([A-Za-z]+)(\d+)\z/o ) { - my $vl = $1; - my $vn = $2; - if ( $infl eq $supl ) { - if ( $vl eq $infl and $vn >= $infn and $vn <= $supl ) { - return 1; - } - } - elsif ( $infl lt $supl ) { - if ( $vl eq $infl and $vn >= $infn ) { - return 1; - } - if ( $vl eq $supl and $vn <= $supn ) { - return 1; - } - if ( $vl gt $infl and $vl lt $supl ) { - return 1 - } - } - else { - alerte("FORMAT $champ INIST BIZARRE \"$val1\"") - } - } - } -else { - alerte("FORMAT $champ INIST INATTENDU \"$val1\""); - if ( $val2 !~ /^\d+\z/o and - $val2 !~ /^([A-Za-z]+)(\d+)\z/o and - $val2 !~ /^(\d+)[-\x{2010}-\x{2015}\x{2212}](\d+)\z/o and - $val2 !~ /^([A-Za-z])(\d+)[-\x{2010}-\x{2015}\x{2212}]([A-Za-z])(\d+)\z/o ) { - alerte("FORMAT $champ ISTEX INATTENDU \"$val2\""); - } - } - -return 0; -} - -sub groupe -{ -my $ref = shift; - -my $query = ""; -my @liste = (); - -return @liste if not defined $ref or ref($ref) ne 'HASH'; - -alerte(); - -my %hash = %{$ref}; - -if ( defined $hash{'revue'} ) { - my $revue = propre($hash{'revue'}); - $query = "host.title:\"$revue\""; - } - -if ( defined $hash{'serie'} ) { - my $revue = propre($hash{'serie'}); - if ( $revue !~ /#/o ) { - $query .= " AND " if $query; - $query = "serie.title:\"$revue\""; - } - } - -if ( defined $hash{'issn'} ) { - my $issn = propre($hash{'issn'}); - $query .= " AND " if $query; - $query .= "host.issn:\"$issn\""; - } - -if ( defined $hash{'publicationDate'} ) { - my $pdate = propre($hash{'publicationDate'}); - $query .= " AND " if $query; - $query .= "host.publicationDate:\"$pdate\""; - } -elsif ( defined $hash{'copyrightDate'} ) { - my $cdate = propre($hash{'copyrightDate'}); - $query .= " AND " if $query; - $query .= "host.copyrightDate:\"$cdate\""; - } - -if ( defined $hash{'volume'} ) { - my $volume = propre($hash{'volume'}); - $query .= " AND " if $query; - if ( $volume =~ /^\d+\z/o ) { - $query .= "host.volume:\"$volume\""; - } - else { - $query .= "host.volume.raw:\"$volume\""; - } - } - -if ( defined $hash{'fascicule'} ) { - my $fascicule = propre($hash{'fascicule'}); - $query .= " AND " if $query; - if ( $fascicule =~ /^\d+\z/o ) { - $query .= "host.issue:$fascicule"; - } - else { - $query .= "host.issue.raw:\"$fascicule\""; - } - } - -if ( defined $hash{'pagedebut'} and - defined $hash{'pagefin'} ) { - my $pagedebut = propre($hash{'pagedebut'}); - my $pagefin = propre($hash{'pagefin'}); - $query .= " AND " if $query; - if ( $pagedebut =~ /^\d+\z/o and $pagefin =~ /^\d+\z/o ) { - $query .= "host.pages.first:[$pagedebut TO $pagefin]"; - $query .= " AND host.pages.last:[$pagedebut TO $pagefin]"; - } - else { - $query .= "host.pages.first.raw:[$pagedebut TO $pagefin]"; - $query .= " AND host.pages.last.raw:[$pagedebut TO $pagefin]"; - } - } - -## Envoi de la requête -print "ALT : \"$url$query&$out\"\n"; - -my $perl = get_hits($query); -if ( defined $perl ) { - my %top = %{$perl}; - if ( $top{'total'} >= 1 ) { - foreach my $hit (@{$top{'hits'}}) { - my %hit = %{$hit}; - my $id = $hit{'id'}; - my $ark = $hit{'arkIstex'}; - my $titre = $hit{'title'}; - my $doi = 'N/A'; - if ( defined $hit{'doi'} ) { - $doi = $hit{'doi'}->[0]; - } - my @auteurs = (); - if ( $hit{'author'} ) { - foreach my $auteur (@{$hit{'author'}}) { - if ( defined $auteur->{'name'} ) { - push(@auteurs, $auteur->{'name'}); - } - } - } - if ( $hit{'host'} ) { - my %host = %{$hit{'host'}}; - if ( defined $host{'pages'} ) { - my ($debut, $fin) = (undef, undef); - if ( defined $host{'pages'}->{'first'} ) { - $debut = $host{'pages'}->{'first'}; - } - if ( defined $host{'pages'}->{'last'} ) { - $fin = $host{'pages'}->{'last'}; - } - if ( $debut and $fin ) { - my $tmp = "$debut\t$fin\t"; - $tmp .= join("|", @auteurs); - $tmp .= "\t$titre\t$id\t$ark\t$doi"; - push(@liste, $tmp); - } - } - } - } - } - } - -return @liste; -} - -sub revue -{ -my ($title, @liste) = @_; - -my $match = 0; - -my $rv = lc(join(" ", ($title =~ /(\w+)/go))); -foreach my $item (@liste) { - my $jn = decode_entities($item); - if ( $jn eq $title or lc($jn) eq lc($title) ) { - $match ++; - } - else { - my $tmp = lc(join(" ", ($jn =~ /(\w+)/go))); - if ( $tmp eq $rv ) { - $match ++; - } - elsif ( $tmp =~ / [a-z]\z/o and $rv =~ /^$tmp / ) { - $match ++; - print "\t -> $num\t$tmp\t$rv\n" if not $modifs{"$tmp\t$rv"}; - $modifs{"$tmp\t$rv"} ++; - } - elsif ( $rv =~ / [a-z]\z/o and $tmp =~ /^$rv / ) { - $match ++; - print "\t -> $num\t$tmp\t$rv\n" if not $modifs{"$tmp\t$rv"}; - $modifs{"$tmp\t$rv"} ++; - } - else { - my $tmp1 = join(" ", grep(!/^(and|et|und|e|y)\z/, split(/ +/, $tmp))); - my $tmp2 = join(" ", grep(!/^(and|et|und|e|y)\z/, split(/ +/, $rv))); - if ( $tmp1 eq $tmp2 ) { - $match ++; - } - else { - $tmp1 =~ s/^(the|die|das|les?|la?|du|[ei]l) //o; - $tmp2 =~ s/^(the|die|das|les?|la?|du|[ei]l) //o; - $match ++ if $tmp1 eq $tmp2; - } - } - } - if ( not $match ) { - if ( $jn =~ /\s*: /o ) { - my ($tmp) = ($jn =~ /^(.+)\s*:/o); - if ( $tmp eq $title or lc($tmp) eq lc($title) ) { - $match ++; - } - } - if ( $title =~ /\s*: /o ) { - my ($tmp) = ($title =~ /^(.+)\s*:/o); - if ( $jn eq $tmp or lc($jn) eq lc($tmp) ) { - $match ++; - } - } - } - } - -return $match; -} - - -__DATA__ - -## -## NE PAS MODIFIER ! -## -## DO NOT EDIT! -## - -33 excl -34 dquot -35 num -36 dollar -37 percnt -40 lpar -41 rpar -42 ast -43 plus -44 comma -45 hyphen -46 period -47 sol -58 colon -59 semi -61 equals -63 quest -64 commat -91 lsqb -92 bsol -93 rsqb -95 lowbar -96 grave -123 lcub -124 verbar -256 Amacr; -257 amacr; -258 Abreve; -259 abreve; -260 Aogon; -261 aogon; -262 Cacute; -263 cacute; -264 Ccirc; -265 ccirc; -266 Cdot; -267 cdot; -268 Ccaron; -269 ccaron; -270 Dcaron; -271 dcaron; -272 Dstrok; -273 dstrok; -274 Emacr; -275 emacr; -278 Edot; -279 edot; -280 Eogon; -281 eogon; -282 Ecaron; -283 ecaron; -284 Gcirc; -285 gcirc; -286 Gbreve; -287 gbreve; -288 Gdot; -289 gdot; -290 Gcedil; -291 gcedil; -292 Hcirc; -293 hcirc; -294 Hstrok; -295 hstrok; -296 Itilde; -297 itilde; -298 Imacr; -299 imacr; -302 Iogon; -303 iogon; -304 Idot; -305 inodot; -306 IJlig; -307 ijlig; -308 Jcirc; -309 jcirc; -310 Kcedil; -311 kcedil; -312 kgreen; -313 Lacute; -314 lacute; -315 Lcedil; -316 lcedil; -317 Lcaron; -318 lcaron; -319 Lmidot; -320 lmidot; -321 Lstrok; -322 lstrok; -323 Nacute; -324 nacute; -325 Ncedil; -326 ncedil; -327 Ncaron; -328 ncaron; -329 napos; -330 ENG; -331 eng; -332 Omacr; -333 omacr; -336 Odblac; -337 odblac; -340 Racute; -341 racute; -342 Rcedil; -343 rcedil; -344 Rcaron; -345 rcaron; -346 Sacute; -347 sacute; -348 Scirc; -349 scirc; -350 Scedil; -351 scedil; -354 Tcedil; -355 tcedil; -356 Tcaron; -357 tcaron; -358 Tstrok; -359 tstrok; -360 Utilde; -361 utilde; -362 Umacr; -363 umacr; -364 Ubreve; -365 ubreve; -366 Uring; -367 uring; -368 Udblac; -369 udblac; -370 Uogon; -371 uogon; -372 Wcirc; -373 wcirc; -374 Ycirc; -375 ycirc; -377 Zacute; -378 zacute; -379 Zdot; -380 zdot; -381 Zcaron; -382 zcaron; -501 gacute; -711 caron; -728 breve; -729 dot; -730 ring; -731 ogon; -733 dblac; -902 Aacgr; -904 Eacgr; -905 EEacgr; -906 Iacgr; -908 Oacgr; -910 Uacgr; -911 OHacgr; -912 idiagr; -913 Agr; -914 Bgr; -915 Ggr; -916 Dgr; -917 Egr; -918 Zgr; -919 EEgr; -920 THgr; -921 Igr; -922 Kgr; -923 Lgr; -924 Mgr; -925 Ngr; -926 Xgr; -927 Ogr; -928 Pgr; -929 Rgr; -931 Sgr; -932 Tgr; -933 Ugr; -934 PHgr; -935 KHgr; -936 PSgr; -937 OHgr; -938 Idigr; -939 Udigr; -940 aacgr; -941 eacgr; -942 eeacgr; -943 iacgr; -944 udiagr; -945 agr; -946 bgr; -947 ggr; -948 dgr; -949 egr; -950 zgr; -951 eegr; -952 thgr; -953 igr; -954 kgr; -955 lgr; -956 mgr; -957 ngr; -958 xgr; -959 ogr; -960 pgr; -961 rgr; -962 sfgr; -963 sgr; -964 tgr; -965 ugr; -966 phgr; -967 khgr; -968 psgr; -969 ohgr; -970 idigr; -971 udigr; -972 oacgr; -973 uacgr; -974 ohacgr; -977 thetav; -981 phiv; -988 gammad; -1008 kappav; -1009 rhov; -1025 IOcy; -1026 DJcy; -1027 GJcy; -1028 Jukcy; -1029 DScy; -1030 Iukcy; -1031 YIcy; -1032 Jsercy; -1033 LJcy; -1034 NJcy; -1035 TSHcy; -1036 KJcy; -1038 Ubrcy; -1039 DZcy; -1040 Acy; -1041 Bcy; -1042 Vcy; -1043 Gcy; -1044 Dcy; -1045 IEcy; -1046 ZHcy; -1047 Zcy; -1048 Icy; -1049 Jcy; -1050 Kcy; -1051 Lcy; -1052 Mcy; -1053 Ncy; -1054 Ocy; -1055 Pcy; -1056 Rcy; -1057 Scy; -1058 Tcy; -1059 Ucy; -1060 Fcy; -1061 KHcy; -1062 TScy; -1063 CHcy; -1064 SHcy; -1065 SHCHcy; -1066 HARDcy; -1067 Ycy; -1068 SOFTcy; -1069 Ecy; -1070 YUcy; -1071 YAcy; -1072 acy; -1073 bcy; -1074 vcy; -1075 gcy; -1076 dcy; -1077 iecy; -1078 zhcy; -1079 zcy; -1080 icy; -1081 jcy; -1082 kcy; -1083 lcy; -1084 mcy; -1085 ncy; -1086 ocy; -1087 pcy; -1088 rcy; -1089 scy; -1090 tcy; -1091 ucy; -1092 fcy; -1093 khcy; -1094 tscy; -1095 chcy; -1096 shcy; -1097 shchcy; -1098 hardcy; -1099 ycy; -1100 softcy; -1101 ecy; -1102 yucy; -1103 yacy; -1105 iocy; -1106 djcy; -1107 gjcy; -1108 jukcy; -1109 dscy; -1110 iukcy; -1111 yicy; -1112 jsercy; -1113 ljcy; -1114 njcy; -1115 tshcy; -1116 kjcy; -1118 ubrcy; -1119 dzcy; -8196 emsp13; -8197 emsp14; -8199 numsp; -8200 puncsp; -8202 hairsp; -8208 dash; -8211 ndash; -8212 mdash; -8213 horbar; -8214 Verbar; -8229 nldr; -8244 tprime; -8245 bprime; -8257 caret; -8259 hybull; -8411 tdot; -8412 DotDot; -8453 incare; -8459 hamilt; -8463 planck; -8466 lagran; -8467 ell; -8470 numero; -8471 copysr; -8478 rx; -8486 ohm; -8491 angst; -8492 bernou; -8499 phmmat; -8500 order; -8502 beth; -8503 gimel; -8504 daleth; -8531 frac13; -8532 frac23; -8533 frac15; -8534 frac25; -8535 frac35; -8536 frac45; -8537 frac16; -8538 frac56; -8539 frac18; -8540 frac38; -8541 frac58; -8542 frac78; -8597 varr; -8598 nwarr; -8599 nearr; -8600 drarr; -8601 dlarr; -8602 nlarr; -8603 nrarr; -8605 rarrw; -8606 Larr; -8608 Rarr; -8610 larrtl; -8611 rarrtl; -8614 map; -8617 larrhk; -8618 rarrhk; -8619 larrlp; -8620 rarrlp; -8621 harrw; -8622 nharr; -8624 lsh; -8625 rsh; -8630 cularr; -8631 curarr; -8634 olarr; -8635 orarr; -8636 lharu; -8637 lhard; -8638 uharr; -8639 uharl; -8640 rharu; -8641 rhard; -8642 dharr; -8643 dharl; -8644 rlarr2; -8646 lrarr2; -8647 larr2; -8648 uarr2; -8649 rarr2; -8650 darr2; -8651 lrhar2; -8652 rlhar2; -8653 nlArr; -8654 nhArr; -8655 nrArr; -8661 vArr; -8666 lAarr; -8667 rAarr; -8705 comp; -8708 nexist; -8714 epsis; -8717 bepsi; -8720 coprod; -8722 minus; -8723 mnplus; -8724 plusdo; -8726 setmn; -8728 compfn; -8735 ang90; -8737 angmsd; -8738 angsph; -8739 mid; -8740 nmid; -8741 par; -8742 npar; -8750 conint; -8757 becaus; -8765 bsim; -8768 wreath; -8769 nsim; -8771 sime; -8772 nsime; -8775 ncong; -8777 nap; -8778 ape; -8780 bcong; -8782 bump; -8783 bumpe; -8784 esdot; -8785 eDot; -8786 efDot; -8787 erDot; -8788 colone; -8789 ecolon; -8790 ecir; -8791 cire; -8793 wedgeq; -8796 trie; -8802 nequiv; -8806 lE; -8807 gE; -8808 lne; -8809 gne; -8810 Lt; -8811 Gt; -8812 twixt; -8814 nlt; -8815 ngt; -8816 nle; -8817 nge; -8818 lsim; -8819 gsim; -8822 lg; -8823 gl; -8826 pr; -8827 sc; -8828 pre; -8829 sce; -8830 prsim; -8831 scsim; -8832 npr; -8833 nsc; -8837 nsup; -8840 nsube; -8841 nsupe; -8842 subne; -8843 supne; -8846 uplus; -8847 sqsub; -8848 sqsup; -8849 sqsube; -8850 sqsupe; -8851 sqcap; -8852 sqcup; -8854 ominus; -8856 osol; -8857 odot; -8858 ocir; -8859 oast; -8861 odash; -8862 plusb; -8863 minusb; -8864 timesb; -8865 sdotb; -8866 vdash; -8867 dashv; -8868 top; -8871 models; -8872 vDash; -8873 Vdash; -8874 Vvdash; -8876 nvdash; -8877 nvDash; -8878 nVdash; -8879 nVDash; -8882 vltri; -8883 vrtri; -8884 ltrie; -8885 rtrie; -8888 mumap; -8890 intcal; -8891 veebar; -8892 barwed; -8900 diam; -8902 sstarf; -8903 divonx; -8904 bowtie; -8905 ltimes; -8906 rtimes; -8907 lthree; -8908 rthree; -8909 bsime; -8910 cuvee; -8911 cuwed; -8912 Sub; -8913 Sup; -8914 Cap; -8915 Cup; -8916 fork; -8918 ldot; -8919 gsdot; -8920 Ll; -8921 Gg; -8922 leg; -8923 gel; -8924 els; -8925 egs; -8926 cuepr; -8927 cuesc; -8928 npre; -8929 nsce; -8934 lnsim; -8935 gnsim; -8936 prnsim; -8937 scnsim; -8938 nltri; -8939 nrtri; -8940 nltrie; -8941 nrtrie; -8942 vellip; -8966 Barwed; -8972 drcrop; -8973 dlcrop; -8974 urcrop; -8975 ulcrop; -8981 telrec; -8982 target; -8988 ulcorn; -8989 urcorn; -8990 dlcorn; -8991 drcorn; -8994 frown; -8995 smile; -9251 blank; -9416 oS; -9472 boxh; -9474 boxv; -9484 boxdr; -9488 boxdl; -9492 boxur; -9496 boxul; -9500 boxvr; -9508 boxvl; -9516 boxhd; -9524 boxhu; -9532 boxvh; -9552 boxH; -9553 boxV; -9554 boxdR; -9555 boxDr; -9556 boxDR; -9557 boxdL; -9558 boxDl; -9559 boxDL; -9560 boxuR; -9561 boxUr; -9562 boxUR; -9563 boxuL; -9564 boxUl; -9565 boxUL; -9566 boxvR; -9567 boxVr; -9568 boxVR; -9569 boxvL; -9570 boxVl; -9571 boxVL; -9572 boxHd; -9573 boxhD; -9574 boxHD; -9575 boxHu; -9576 boxhU; -9577 boxHU; -9578 boxvH; -9579 boxVh; -9580 boxVH; -9600 uhblk; -9604 lhblk; -9608 block; -9617 blk14; -9618 blk12; -9619 blk34; -9633 squ; -9642 squf; -9645 rect; -9646 marker; -9651 xutri; -9652 utrif; -9653 utri; -9656 rtrif; -9657 rtri; -9661 xdtri; -9662 dtrif; -9663 dtri; -9666 ltrif; -9667 ltri; -9675 cir; -9733 starf; -9734 star; -9742 phone; -9792 female; -9794 male; -9834 sung; -9837 flat; -9838 natur; -9839 sharp; -10003 check; -10007 cross; -10016 malt; -10022 lozf; -10038 sext; -64256 fflig; -64257 filig; -64258 fllig; -64259 ffilig; - -## -## The End! -## diff --git a/correction/README.md b/correction/README.md deleted file mode 100644 index 35155a5..0000000 --- a/correction/README.md +++ /dev/null @@ -1,139 +0,0 @@ -Correction de l’alignement Pascal-Francis / Istex -=============== - -Programme de correction de l’alignement des notices bibliographiques Inist avec les documents Istex - -Le programme `recupErreurs.pl` permet de corriger les erreurs apparues lors de l’alignement des bases bibliographiques Pascal et Francis de l’**Inist** avec la base **Istex** si elles sont dues à des problèmes de connexion à l’API **Istex** ou, à défaut, d’isoler les notices bibliographiques responsables d’une erreur de syntaxe lors de la génération de la requête à l’API. Dans ce dernier cas, le programme permet également après correction de ces notices de modifier le fichier de sortie du programme d’alignement `matchStan2Istex.pl` pour inclure les réponses correctes. - -À noter que si ce programme est utilisé à l'Inist, il est recommandé d’éviter de passer par le proxy. Pour cela, il faut supprimer les variables globales le définissant, ce qui se fait avec la commande  : `unset http_proxy https_proxy no_proxy`. Vérifiez également avec la commande `env` si ces mêmes variables n'existent pas en majuscule. Auquel cas, supprimez les avec la commande : `unset HTTP_PROXY HTTPS_PROXY NO_PROXY`. - - -### Usage - -```txt - recupErreurs_v3.pl -h hfd -a alignement -r rejet [ -l log ] [ -m matchStan ] - recupErreurs_v3.pl -f fichier -a alignement -r rejet [ -l log ] [ -m matchStan ] - recupErreurs_v3.pl -i -``` - - -### Options - - -``` - -a indique le nom du fichier de résultats de l’alignement dont on doit - corriger les erreurs - -f indique le nom du fichier d’entrée contenant les notices Pascal ou Francis - (qui peut être un fichier compressé avec “gzip” ou “bzip2”) - -h indique le nom du fichier HFD servant d’entrée au programme - -i affiche cette aide. - -l indique le nom du fichier “log” qui recevra, à la fois, le résultat avant - et après lorsqu’une notice traitée donnera un résultat différent - -m indique le nom et le chemin du programme d’alignement si ce n'est pas - celui par défaut - -r indique le nom du fichier contenant les notices Pascal ou Francis ayant - été modifiées parce que les notices originales ont provoqué une erreur -``` - - -### Correction - -#### 1 - Détection des erreurs - -Pour voir si votre fichier de résultats a des erreurs, un simple `grep` suffit. Pour le fichier `P95_out.txt` contenant les résultats bruts de Pascal 1995, la commande suivante permet de compter le nombre d’erreurs par type : -```bash -grep ' => ERREUR ' P95_out.txt | sort | uniq -c -``` -Si votre fichier est compressé avec `gzip`, cette commande devient : -```bash -gzip -cd P95_out.txt.gz | grep ' => ERREUR ' | sort | uniq -c -``` -Évidemment, s’il n’y a pas d’erreur, on s’arrête là. Autrement, on fait un premier passage avec `recupErreurs.pl` - -#### 2 - Premier passage - -Il consiste à traiter les mêmes notices Pascal ou Francis en indiquant dans quel fichier stocker les notices qui n'ont pas pu être corrigées. Si vous êtes parti du HFD des notices Pascal 1995 `Pascal.strd95.bib` et si vous compressez vos fichiers de résultats, la commande est : -```bash -recupErreurs.pl -h Pascal.strd95.bib -a P95_out.txt.gz -r rejetP95.txt | gzip -c9 > P95_out2.txt.gz -``` -Vous pouvez également créer un fichier de “log” avec l’option `-l` et vous devez donnez le nom, voire le chemin, du programme `matchStan2Istex.pl` si vous n’utilisez pas celui par défaut ou s’il n’est pas dans un répertoire déclaré dans la variable `PATH`. - -Si le fichier `rejetP95.txt` obtenu est vide, alors, la correction est terminée. Sinon, il faudra corriger les notices contenues dans ce fichier avant de passer à l’étape suivante. - -#### 3 - Deuxième passage - -La syntaxe de la commande est fondamentalement la même que pour le premier passage. Simplement, on substitue le nouveau fichier de résultats à l’ancien : -```bash -recupErreurs.pl -h Pascal.strd95.bib -a P95_out2.txt.gz -r rejetP95.txt | gzip -c9 > P95_out3.txt.gz -``` -Normalement, là, votre fichier de résultats est correct. En fait, on ne devrait plus avoir besoin de ce deuxième passage, comme il est dit plus bas. - - -### Types d’erreur - -#### 1 - Erreur de connexion - -Il arrive que la connexion à l’API ne se fasse pas ou qu’elle se passe mal. On obtient alors un code retour 500 avec différents messages d’erreur comme : - -```txt -500 Can't connect to api.istex.fr:443 (Bad hostname 'api.istex.fr') -500 Can't connect to api.istex.fr:443 (Échec temporaire dans la résolution du nom) -500 Internal Server Error -500 Status read failed: Connection reset by peer -500 Server closed connection without sending any data back -``` - -Dans certains cas, l’API renvoie effectivement une réponse, mais la connexion est coupée et on a un enregistrement JSON tronqué. L’analyse de cette réponse donnera également un message d’erreur : - -``` -ERREUR CONVERSION JSON -> PERL ! -``` - -Dans tous ces cas, on peut obtenir une réponse correcte en relançant l’alignement sur ces seules notices. - - -#### 2 - Erreur de syntaxe - -Certaines notices contiennent des champs avec une ou des erreurs qui font que la requête générée par le programme `matchStan2Istex.pl` ne suivra pas la syntaxe requise par l’API **Istex**. On a alors une erreur 400 : - -```txt -400 Bad Request -``` - -On trouve ces erreurs surtout dans les numéros de volume ou de fascicule ou dans les noms d’auteur, mais pas seulement. Dans l’exemple suivant, tiré de la notice Pascal `90-0351247`, le champ correspondant au deuxième auteur est : - -```sgml -AVIL#A (J. G. A.) -``` -Pour rappel, les notices ne sont pas en XML, mais en SGML et utilise des entités caractères pour les caractères accentués et les symboles. L’entité caractère `#` correspond au caractère dièse `#`. La partie de la requête consacrée aux auteur est alors : - -```txt -author.name:("PEREZ" OR "AVIL#A" OR "MARTINEZ") -``` - -Ce caractère `#` qui n'est pas encodé en `%23` provoque une erreur immédiate. - -Mais, normalement, **ce genre d’erreur ne devrait plus arriver** parce que la totalité des notices à l’origine de ces messages `400 Bad Request` ont été corrigées. - - -### Fichiers générés par `recupErreurs.pl` - -#### 1 - Fichier de notices rejetées - -Le nom de ce fichier est donné par l’option `-r`. Il contient pour chaque notice ayant donné une erreur 400 : - - - la requête générée par le programme `matchStan2Istex.pl` mise en commentaire - - la notice Inist au format Inist 1994 SGML - -La présence de la requête permet de la tester sur un navigateur Internet et, ainsi, trouver l’erreur. La notice pourra ensuite être corrigée (ce qui demande une bonne connaissance du format). - -Après correction, ce même fichier pourra être utilisé pour corriger le résultat de l’alignement. - -#### 2 - Fichier en sortie standard - -Ce fichier est strictement identique dans sa forme au fichier produit par le programme `matchStan2Istex.pl`. - -#### 3 - Fichier de “log” - -Ce fichier est optionnel. Si vous l’avez demandé avec l’option `-l`, vous obtiendrez, pour chaque notice testée, l’identifiant Inist de la notice et, si une modification a eu lieu, le résultat de l’alignement avant et après. - diff --git a/correction/recupErreurs.pl b/correction/recupErreurs.pl deleted file mode 100755 index e798454..0000000 --- a/correction/recupErreurs.pl +++ /dev/null @@ -1,368 +0,0 @@ -#!/usr/bin/perl - - -# Déclaration des pragmas -use strict; -use utf8; -use open qw/:std :utf8/; - -# Appel des modules externes de base -use Encode; -use Getopt::Long; - -# Appel des modules spécifiques à l'application -# ??? - -my ($programme) = $0 =~ m|^(?:.*/)?(.+)|; -my $version = "3.1.5"; -my $dateModif = "26 Février 2021"; - -my $usage = "Usage : \n" . - " $programme -h hfd -a alignement -r rejet [ -l log ] [ -m matchStan ] \n" . - " $programme -f fichier -a alignement -r rejet [ -l log ] [ -m matchStan ] \n" . - " $programme -i \n"; - -my $alignement = undef; -my $fichier = undef; -my $hfd = undef; -my $info = undef; -my $log = undef; -my $rejet = undef; -my $matchStan = "matchStan2Istex_v12c.pl"; - -eval { - $SIG{__WARN__} = sub {usage(1);}; - GetOptions( - "alignement=s" => \$alignement, - "fichier=s" => \$fichier, - "hfd=s" => \$hfd, - "info" => \$info, - "log=s" => \$log, - "rejet=s" => \$rejet, - "match=s" => \$matchStan, - ); - }; -$SIG{__WARN__} = sub {warn $_[0];}; - -if ( $info ) { - print "Programme : \n"; - print " “$programme”, version $version ($dateModif)\n"; - print " Permet de chercher les erreurs dans le fichier de résultats obtenu \n"; - print " avec le programme “$matchStan” et de les corriger. \n"; - print "\n"; - print $usage; - print "\nOptions : \n"; - print " -a indique le nom du fichier de résultats de l’alignement dont on doit \n"; - print " corriger les erreurs \n"; - print " -f indique le nom du fichier d’entrée contenant les notices Pascal ou Francis \n"; - print " (qui peut être un fichier compressé avec “gzip” ou “bzip2”) \n"; - print " -h indique le nom du fichier HFD servant d’entrée au programme \n"; - print " -i affiche cette aide. \n"; - print " -l indique le nom du fichier qui recevra, à la fois, le résultat avant et \n"; - print " après lorsqu’une notice traitée donnera un résultat différent \n"; - print " -m indique le nom du programme d’alignement si ce n'est pas celui par défaut \n"; - print " -r indique le nom du fichier contenant les notices Pascal ou Francis ayant \n"; - print " été modifiées parce que les notices originales ont provoqué une erreur \n"; - print " \n"; - print "N.B. : pour ne pas passer par le proxy sur le réseau interne de l’INIST, il faut \n"; - print " effacer les variables globales du proxy par la commande “unset http_proxy \n"; - print " https_proxy no_proxy” avant de lancer le programme “$programme”. \n"; - print " \n"; - - exit 0; - } - -usage(2) if not $alignement or not $rejet; -usage(2) if not $fichier and not $hfd; -usage(2) if $fichier and $hfd; - -if ( $hfd and not -d $hfd ) { - print STDERR "Fichier HFD \"$hfd\" absent !\n"; - exit(3); - } - -# Variables -my $blancs = 0; -my $temp = "rEtmp$$.sgml"; -my @lignes = (); -my %correct = (); -my %notice = (); - -# Gestion des interruptions -$SIG{'HUP'} = 'nettoie'; -$SIG{'INT'} = 'nettoie'; -$SIG{'QUIT'} = 'nettoie'; -$SIG{'TERM'} = 'nettoie'; - -if ( $rejet ) { - if ( -f $rejet ) { - open(INP, "<:raw", $rejet) or die "$!,"; - while() { - next if /^\s*$/o; - next if /^#/o; - my ($inist) = m|(.+?)|o; - $correct{$inist} = $_; - } - close INP; - } - } - -if ( defined $fichier ) { - if ( $fichier eq '-' ) { - open(REC, "<&STDIN") or die "$!,"; - binmode(REC, ":raw"); - } - elsif ( $fichier =~ /\.gz\z/o ) { - open(REC, "gzip -cd $fichier |") or die "$!,"; - binmode(REC, ":raw"); - } - elsif ( $fichier =~ /\.bz2\z/o ) { - open(REC, "bzip2 -cd $fichier |") or die "$!,"; - binmode(REC, ":raw"); - } - else { - open(REC, "<:raw", $fichier) or die "$!,"; - } - } -elsif ( defined $hfd ) { - open(REC, "IhfdCat $hfd |") or die "$!,"; - binmode(REC, ":raw"); - } - -my ($rec, $inist, $refaire) = suivant(); - -open(LOG, ">:utf8", $log) or die "$!,"; - -if ( $alignement =~ /\.gz\z/o ) { - open(INP, "gzip -cd $alignement |") or die "$!,"; - binmode(INP, ":utf8"); - } -elsif ( $alignement =~ /\.bz2\z/o ) { - open(INP, "bzip2 -cd $alignement |") or die "$!,"; - binmode(INP, ":utf8"); - } -else { - open(INP, "<:utf8", $alignement) or die "$!,"; - } -while() { - if ( /^\s*$/o ) { - $blancs ++; - if ( @lignes ) { - passe(@lignes); - @lignes = (); - print "\n"; - } - else { - print $_ if $blancs == 1; - } - } - else { - push(@lignes, $_); - $blancs = 0; - } - } -close INP; - -if ( @lignes ) { - passe(@lignes); - } - - -exit 0; - - -sub usage -{ -print STDERR $usage; - -exit shift; -} - -sub suivant -{ -my $ligne = ; - -if ( defined $ligne ) { - my ($id) = $ligne =~ m|(.+?)|o; - if ( $correct{$id} ) { - $ligne = $correct{$id}; - } - my $status = erreur($ligne); - return ($ligne, $id, $status); - } - -return (undef, undef, undef); -} - -sub erreur -{ -my $ligne = shift; - -if ( m|(.+?)|o ) { - my $champ = $1; - my $pages = ""; - if ( $champ =~ m|(.+?)|o ) { - $pages = $1; - } - elsif ( $champ =~ m|(.+?)|o ) { - $pages = $1; - } - if ( $pages ) { - $pages =~ s|•|.|go; - $pages =~ s|−|-|go; - $pages =~ s|/|/|go; - $pages =~ s/^ +//o; - if ( $pages =~ /^(&\w+gr; )?vol\. *\S+?, */io or - $pages =~ /^(&\w+gr; )?vol \S+?, */io or - $pages =~ /^(&\w+gr; )?vol\d+, */io or - $pages =~ /^&\w+gr;,? */o ) { - $pages = $'; - } - if ( $pages =~ / *[.+?(].*)?.*\z/io or - $pages =~ / +\d+ p\.].*/io ) { - $pages = $`; - } - if ( $pages =~ / *\(.+?\).*\z/io ) { - $pages = $`; - } - if ( $pages =~ /^([0ivx][ivx]*(-[ivx]+)?,? *([ivx]+(-[ivx]+)?,? *)*) (.+)\z/io ) { - $pages = $5; - } - if ( $pages =~ /^s\.p\.\s*\z/io ) { - return 0; - } - elsif ( $pages =~ /^(\d+)-(\d+) +p\./io ) { - return 0; - } - elsif ( $pages =~ /^\S+ +p\./io ) { - return 0; - } - elsif ( $pages =~ /^p\. *(\S+)\z/io ) { - return 0; - } - elsif ( $pages =~ /^(\S+-\S+)-(\S+-\S+)\z/o ) { - return 0; - } - elsif ( $pages =~ /^(\S+?)(-\S+)?,( *(\S+-)?(\S+),)* *(\S+-)?(\S+) *\z/o ) { - return 1; - } - } - } - -return 0; -} - -sub passe -{ -my @liste = @_; - -foreach my $ligne (@liste) { - if ( $ligne =~ /^[_0\.\*\+]+[^\t]*\t(\d+\.\d+\W?|-)\t[AMC]\t(\d+(-\d+)+)\t/o ) { - my $valeur = $1; - my $id = $2; - while ( $id ne $inist ) { - ($rec, $inist, $refaire) = suivant(); - } - if ( $valeur =~ /^\d+\.\d+\z/o ) { - $refaire ++ if $valeur <= 4.000 and $valeur >= 3.490; - } - $refaire ++ if grep(/^\t => ERREUR /o, @liste) > 0; - if ( $refaire ) { - open(TMP, ">:raw", $temp) or die "$!,"; - print TMP $rec; - close TMP; - my $nb = 0; - my $ok = 0; - while( not $ok ) { - open(MSI, "$matchStan -f $temp |") or die "$!,"; - binmode(MSI, ":utf8"); - my @sortie = grep(/\S+/, ); - close MSI; - if ( grep(/^\t => ERREUR /o, @sortie) == 0 ) { - print @sortie; - compare($id, \@liste, \@sortie); - print STDERR "Notice \"$id\" modifiée \n"; - return; - } - elsif ( grep(/^\t => ERREUR 400 /o, @sortie) > 0 ) { - print @liste; - compare($id, \@liste, \@sortie); - print STDERR "Notice \"$id\" erreur 400 !\n"; - return; - } - else { - $nb ++; - if ( $nb >= 10 ) { - print STDERR "Problème notice \"$id\" !\n"; - print @liste; - return; - } - } - } - die "Impossible de supprimer \"$temp\" : $!," if not unlink $temp; - } - else { - print @liste; - } - return; - } - } - -print @liste; -} - -sub compare -{ -my ($id, $ref1, $ref2) = @_; - -my @liste1 = @{$ref1}; -my @liste2 = @{$ref2}; - -my ($score1, $score2) = (undef, undef); - -print LOG "===> $id <=== \n"; - -foreach my $ligne (@liste1) { - if ( $ligne =~ /^[_0\.\*\+]+[^\t]*\t(\d+\.\d+\W?|-)\t[AMC]\t(\d+(-\d+)+)\t/o ) { - $score1 = $1 - } - } - -foreach my $ligne (@liste2) { - if ( $ligne =~ /^[_0\.\*\+]+[^\t]*\t(\d+\.\d+\W?|-)\t[AMC]\t(\d+(-\d+)+)\t/o ) { - $score2 = $1 - } - } - -if ($#liste1 != $#liste2 or $score1 ne $score2 ) { - print LOG @liste1; - print LOG "-------------------- \n"; - print LOG @liste2; - } - -print LOG "\n"; -} - -sub nettoye -{ -my $signal = shift; - -if ( fileno(TMP) ) { - close TMP; - } -if ( -f "$temp" ) { - die "Impossible de supprimer \"$temp\" : $!," if not unlink $temp; - } - -if ( $signal =~ /^\d+\z/ ) { - exit $signal; - } -if ( $signal ) { - print STDERR "Signal SIG$signal détecté\n"; - exit 9; - } -else { - exit 0; - } -} - diff --git a/dedoublonnage/README.md b/dedoublonnage/README.md deleted file mode 100644 index f6eedd4..0000000 --- a/dedoublonnage/README.md +++ /dev/null @@ -1,51 +0,0 @@ -Dédoublonnage de l’alignement Pascal-Francis / Istex -=============== - -Programme de dédoublonnage des résultats de l’alignement. - -Le programme `weedTei.pl` permet de repérer les doublons dans l’ensemble des fichiers de résultats de l’alignement et de choisir une notice **Inist** avec un score maximal pour chaque document **Istex** apparié. - - -### Usage - -```txt - weedTei3.pl -f fichier[,fichier]* -r répertoire [ -l log ] [ -x ] - weedTei3.pl -h -``` - -### Options - -```txt - -f indique le nom du ou des fichiers d’entrée (qui peuvent être des fichiers - compressés avec “gzip” ou “bzip2”). L’option est répétitive et il est possible - d’indiquer plusieurs noms de fichier en les séparant par des virgules (mais - sans espace entre eux). Si l’argument de l’option est un tiret “-”, alors la - liste des fichiers (pas leur contenu) est lue sur l’entrée standard - -h affiche cette aide - -l indique le nom du fichier “log” contenant la liste des appariements - supprimés - -r indique le nom du répertoire où seront créés les fichiers de sortie - portant le même nom que les fichiers d’entrée - -x accepte comme valides les appariements lorsque la valeur du score est - suivie d’un point d’exclamation (“!”) -``` - - -### Description - -Ce programme lit l'ensemble des fichiers de résultat de l’alignement, recherche les doublons avant de réécrire les fichiers dans un répertoire différent avec le même nom. Lorsqu’il y a un appariement en double, le programme choisit l'appariement avec le meilleur score et, en cas d’égalité, le premier traité. De ce fait, quand on compare un nouveau fichier aux anciens fichiers déjà dédoublonnés, il est préférable de faire passer les anciens fichiers en premier pour limiter les modifications dans ceux-ci. De la même façon, comme certaines notices de Pascal ont été reprises dans Francis, il est préférable de faire passer les fichiers Pascal en premier. -Dans les fichiers créés, les doublons rejetés sont marqués par un signe moins “-” ajouté après le score. Dans l’exemple suivant, on a le résultat pour 2 notices dont l’une est conservée, l’autre rejetée : - -```txt -***** 5.000 A 96-0127566 Adolescent pregnancy and subsequent obesity in african-american girls JOURNAL OF ADOLESCENT HEALTH ! ! ! 1994 15 6 491 494 SEGEL J.S. MCANARNEY, E.R. E47E5C8C67C62B0DA70B1CEF5AED43DA684A18DB ark:/67375/6H6-945TPDV9-D 10.1016/1054-139X(94)90497-Q 1054-139X(94)90497-Q 7811682 -****  4.444- A 95-0012606 Adolescent pregnancy and subsequent obesity in African-American girls Journal of adolescent health ! 1054-139X ! 1994 15 6 194 494 SEGEL J. S. MCANARNEY, E. R. E47E5C8C67C62B0DA70B1CEF5AED43DA684A18DB ark:/67375/6H6-945TPDV9-D 10.1016/1054-139X(94)90497-Q 1054-139X(94)90497-Q 7811682 -``` -Comme dans la documentation du programme `matchStan2Istex.pl`, les champs vides sont signalés par un point d’exclamation. - -Dans le cas de notices groupées où une notice décrit plusieurs articles, les doublons rejetés sont signalés en remplaçant la flèche en début de ligne ` ~~> ` par une flèche différente ` ::> `, comme dans l’exemple suivant : - -```txt - ::> 485 490 Christoph U. Lehmann M.D.|Jane Barr M.D.|Patricia J. Kelly M.D. Emergency department utilization by adolescents AE3EBD19A57CFD17B92295681E1B0F2FD4D62FAB ark:/67375/6H6-92BN6QVT-8 10.1016/1054-139X(94)90496-P 1054-139X(94)90496-P 7811681 - ::> 491 494 Jill S. Segel M.D.|Elizabeth R. McAnarney M.D. Adolescent pregnancy and subsequent obesity in African-American girls E47E5C8C67C62B0DA70B1CEF5AED43DA684A18DB ark:/67375/6H6-945TPDV9-D 10.1016/1054-139X(94)90497-Q 1054-139X(94)90497-Q 7811682 -``` - diff --git a/dedoublonnage/weedTei.pl b/dedoublonnage/weedTei.pl deleted file mode 100755 index 48f31f0..0000000 --- a/dedoublonnage/weedTei.pl +++ /dev/null @@ -1,1414 +0,0 @@ -#!/usr/bin/perl - - -# Déclaration des pragmas -use strict; -use utf8; -use open qw/:std :utf8/; - -# Appel des modules externes de base -use Encode; -use Getopt::Long; - -# Appel des modules spécifiques à l'application -use HTML::Entities qw(decode_entities %entity2char); -## use HTTP::CookieJar::LWP; -use JSON; -## use LWP::UserAgent; -use Text::Unidecode; -## use URI::Encode qw(uri_encode uri_decode); - -my ($programme) = $0 =~ m|^(?:.*/)?(.+)|; -my $Version = "1.5.1"; -my $dateModif = "10 Mars 2021"; - -my $usage = "Usage : \n" . - " $programme -f fichier[,fichier]* -r répertoire [ -l log ] [ -x ] \n" . - " $programme -h \n"; - -my $aide = undef; -my $log = undef; -my $rep = undef; -my $xclam = undef; -my @fichiers = (); -my %dejaVu = (); - -eval { - $SIG{__WARN__} = sub {usage(1);}; - GetOptions( - "fichier=s" => \@fichiers, - "help" => \$aide, - "log=s" => \$log, - "repertoire=s" => \$rep, - "xclam" => \$xclam, - ); - }; -$SIG{__WARN__} = sub {warn $_[0];}; - -if ( $aide ) { - print " \n"; - print "Programme : \n"; - print " “$programme”, version $Version ($dateModif)\n"; - print " Permet de créer les fichiers d’enrichissement avec les codes de classement \n"; - print " et les mots-clés Pascal ou Francis au format TEI StandOff \n"; - print "\n"; - print $usage; - print "\nOptions : \n"; - print " -f indique le nom du ou des fichiers d’entrée (qui peuvent être des fichiers \n"; - print " compressés avec “gzip” ou “bzip2”). L’option est répétitive et il est possible \n"; - print " d’indiquer plusieurs noms de fichier en les séparant par des virgules (mais \n"; - print " sans espace entre eux) \n"; - print " -h affiche cette aide \n"; - print " -l indique le nom du fichier “log” contenant la liste des appariements \n"; - print " supprimés \n"; - print " -r indique le nom du répertoire où seront créés les fichiers de sortie \n"; - print " portant le même nom que les fichiers d’entrée \n"; - print " -x accepte comme valides les appariements lorsque la valeur du score est \n"; - print " suivie d’un point d’exclamation (“!”) \n"; - print " \n"; - - exit 0; - } - -@fichiers = grep {not $dejaVu{$_} ++;} split(/,/, join(",", @fichiers)); -usage(2) if $#fichiers < 0; - -usage(2) if not $rep; - -# Récupération des noms de fichiers sur l'entrée standard -for ( my $nb = 0 ; $nb <= $#fichiers ; $nb ++ ) { - my $fichier = $fichiers[$nb]; - if ( $fichier eq '-' ) { - splice(@fichiers, $nb, 1); - while() { - chomp; - s/\r//o; - next if /^\s*$/o; - next if /^\s*-\s*$/o; - s/^\s+//o; - s/\s+$//o; - push(@fichiers, $_); - } - } - } - -# Variables -my $info = undef; -my $inist = undef; -my $nb = undef; -my $score = undef; -my %groupe = (); -my %info = (); -my %istex = (); -my %match = (); -my %rang = (); -my %rejetD = (); -my %rejetI = (); - -# Complétion de la table des entitées HTML -while() { - next if /^\s*$/o; - next if /^#/o; - chomp; - my ($num, $sgml) = split(/\t+/); - next if $entity2char{$sgml}; - $entity2char{$sgml} = chr($num); - } -close DATA; - -# Ouverture du fichier "log" -if ( $log ) { - open(LOG, ">:utf8", $log) or die "$!,"; - } -else { - open(LOG, ">:utf8", "/dev/null") or die "$!,"; - } - -foreach my $fichier (@fichiers) { - if ( $fichier =~ /\.gz\z/o ) { - open(INP, "gzip -cd $fichier |") or die "$!,"; - binmode(INP, ":utf8"); - } - elsif ( $fichier =~ /\.bz2\z/o ) { - open(INP, "bzip2 -cd $fichier |") or die "$!,"; - binmode(INP, ":utf8"); - } - else { - open(INP, "<:utf8", $fichier) or die "$!,"; - } - - while() { - if (/^([_.0\*\+]+\x{00A0}*)\t(\d\.\d+)(!?)\t/o) { - $score = $2; - my $statut = $3; - $statut = "" if not $xclam; - if ( $score < 3.490 and $statut ne '!' ) { - $inist = undef; - next; - } - chomp; - my @champs = split(/\t/); - $inist = $champs[3]; - my $id = $champs[17]; - $match{$id}{$inist} = $score; - $rang{$id}{$inist} = keys %{$match{$id}}; - $istex{$inist}{$id} = $score; - } - elsif (/^([_.0\*\+]+\x{00A0}*)\t(\d\.\d+)\W\t/o) { - $inist = undef; - } - elsif ( /^ ~~> \t/o ) { - next if not $inist; - chomp; - my @champs = split(/\t/); - my $id = $champs[5]; - next if defined $match{$id}{$inist}; - push(@{$groupe{$inist}}, "$id:$score"); - } - } - close INP; - - foreach $inist (sort keys %groupe) { - my @tmp = @{$groupe{$inist}}; - if ( $#tmp == 0 ) { - my ($id, $valeur) = split(/:/, $tmp[0]); - if ( $match{$id}{$inist} ) { - $rejetI{$inist}; - next; - } - } - my $erreur = 0; - foreach my $item (@tmp) { - my ($id, $valeur) = split(/:/, $item); - if ( defined $match{$id} ) { - my @inist = keys %{$match{$id}}; - $erreur ++ if @inist; - } - } - if ( $erreur ) { - $rejetI{$inist} ++; - } - else { - foreach my $item (@tmp) { - my ($id, $valeur) = split(/:/, $item); - $match{$id}{$inist} = $valeur; - } - } - } - } - -foreach my $id (keys %match) { - my @tmp = sort keys %{$match{$id}}; - if ( $#tmp == 0 ) { - delete $match{$id}; - next; - } - $nb ++; - foreach my $num (@tmp) { - $info{$num} ++; - } - } - -# print LOG "Nombre de doublons : $nb \n"; -# foreach my $id (sort keys %match) { -# print LOG " -> $id \n"; -# foreach my $num (sort keys %{$match{$id}}) { -# print LOG "\t$num => $match{$id}{$num} \n"; -# } -# } - -foreach my $fichier (@fichiers) { - if ( $fichier =~ /\.gz\z/o ) { - open(INP, "gzip -cd $fichier |") or die "$!,"; - binmode(INP, ":utf8"); - } - elsif ( $fichier =~ /\.bz2\z/o ) { - open(INP, "bzip2 -cd $fichier |") or die "$!,"; - binmode(INP, ":utf8"); - } - else { - open(INP, "<:utf8", $fichier) or die "$!,"; - } - - while() { - if (/^([_.0\*\+]+\x{00A0}*)\t/o) { - chomp; - my @champs = split(/\t/); - $inist = $champs[3]; - $info = join("\t", @champs[4 .. 16]); -# my $id = $champs[17]; - $info{$inist} = $info if $info{$inist}; - } - } - close INP; - } - -foreach my $id (sort keys %match) { - my %tmp = (); - next if not defined $match{$id}; - foreach my $num (sort keys %{$match{$id}}) { - push(@{$tmp{$match{$id}{$num}}}, $num); - } - my @tmp = sort {$b <=> $a} keys %tmp; - next if $#tmp < 0; - my $max = $tmp[0]; - if ( $#{$tmp{$max}} == 0 ) { - my $correct = $tmp{$max}->[0]; - foreach my $num (sort keys %{$match{$id}}) { - next if $num eq $correct; - $rejetD{$num} ++; - } - } - else { - @tmp = sort {$rang{$id}{$a} <=> $rang{$id}{$b}} @{$tmp{$max}}; - my $total = 0; - for (my $nb = 1 ; $nb <= $#tmp ; $nb ++) { - if ( $info{$tmp[0]} eq $info{$tmp[$nb]} ) { - $total ++; - next; - } - if ( compare($tmp[0], $tmp[$nb]) ) { - $total ++; - next; - } - last; - } - if ( $total == $#tmp ) { - foreach my $num (sort keys %{$match{$id}}) { - next if $num eq $tmp[0]; - $rejetD{$num} ++; - } - } - elsif ( $total > 1 and $total == $#tmp - 1 ) { - print LOG " => $id [$max] \n"; - foreach my $num (@{$tmp{$max}}) { - $rejetD{$num} ++; - print LOG "\t$num\t$info{$num}\n"; - } - print LOG "\n"; - } - else { - print LOG " -> $id [$max] \n"; - foreach my $num (@{$tmp{$max}}) { - $rejetD{$num} ++; - print LOG "\t$num\t$info{$num}\n"; - } - print LOG "\n"; - } - } - } - -foreach my $fichier (@fichiers) { - my $compression = undef; - if ( $fichier =~ /\.gz\z/o ) { - $compression = "gzip"; - open(INP, "gzip -cd $fichier |") or die "$!,"; - binmode(INP, ":utf8"); - } - elsif ( $fichier =~ /\.bz2\z/o ) { - $compression = "bzip2"; - open(INP, "bzip2 -cd $fichier |") or die "$!,"; - binmode(INP, ":utf8"); - } - else { - open(INP, "<:utf8", $fichier) or die "$!,"; - } - - if ( $compression ) { - open(OUT, "| $compression -c > $rep/$fichier") or die "$!,"; - binmode(OUT, ":utf8"); - } - else { - open(OUT, ">:utf8", "$rep/$fichier") or die "$!,"; - } - - while() { - if (/^([_.0\*\+]+\x{00A0}*)\t(\d\.\d+)(!?)\t/o) { - my $score = $2; - my $statut = $3; - my @champs = split(/\t/); - $inist = $champs[3]; - if ( $rejetD{$inist} ) { - $champs[1] = $score . '-'; - $_ = join("\t", @champs); - } - } - elsif (/^([_.0\*\+]+\x{00A0}*)\t(\d\.\d+)(\W?)\t/o) { - $inist = undef; - } - elsif ( /^ ~~> \t/o ) { - if ( $inist and $rejetI{$inist} ) { - s/^ ~~> \t/ ::> \t/o; - } - } - print OUT; - } - close INP; - close OUT; - } - -exit 0; - - -sub usage -{ -print STDERR "\n$usage\n"; - -exit shift; -} - -sub compare -{ -my ($n1, $n2) = @_; - -my $test = 0; -my %trouve = (); - -my @i1 = split(/\t/, $info{$n1}); -my @i2 = split(/\t/, $info{$n2}); -# 0 : titre ; 1 : journal ; 2 : livre ; 3 : $issn ; 4 : isbn ; 5 : date -# 6 : volume ; 7 : fascicule ; 8 : pagedebut ; 9 : pagefin ; 10 : nom1 -# 11 : prenom1 ; 12 : autres - -# ISSN -if ( $i1[3] and $i2[3] ) { - $test ++; - if ( $i1[3] eq $i2[3] or uc($i1[3]) eq uc($i2[3]) ) { - $trouve{'ISSN'} ++; - } - } - -# Revue -if ( $i1[1] and $i2[1] ) { - $test ++; - $trouve{'revue'} ++ if revue($i1[1], $i2[1]); - } - -# Date -if ( $i1[5] and $i2[5] ) { - $test ++; - if ( $i1[5] == $i2[5] or $i1[5] eq $i2[5] ) { - $trouve{'date'} ++; - } - } - -# Volume -if ( $i1[6] and $i2[6] ) { - $test ++; - if ( $i1[6] eq $i2[6] or biniou($i1[6], $i2[6], "VOLUME", $n1, $n2) ) { - $trouve{'volume'} ++; - } - elsif ( unidecode($i1[6]) eq unidecode($i2[6]) ) { - $trouve{'volume'} ++; - } - } - -# Fascicule -if ( $i1[7] and $i2[7] ) { - $test ++; - if ( $i1[7] eq $i2[7] or biniou($i1[7], $i2[7], "FASCICULE", $n1, $n2) ) { - $trouve{'fascicule'} ++; - } - elsif ( unidecode($i1[7]) eq unidecode($i2[7]) ) { - $trouve{'fascicule'} ++; - } - } - -# Page de début -if ( $i1[8] and $i2[8] ) { - $test ++; - $trouve{'pagedebut'} ++ if $i1[8] == $i2[8] or $i1[8] eq $i2[8]; - } - -# Page de fin -if ( $i1[9] and $i2[9] ) { - $test ++; - $trouve{'pagefin'} ++ if $i1[9] == $i2[9] or $i1[9] eq $i2[9]; - } - -# Titre du document -if ( $i1[0] and $i2[0] ) { - $test ++; - if ( ($trouve{'ISSN'} or $trouve{'revue'}) and - ($trouve{'date'} or $trouve{'volume'}) and - ($trouve{'pagedebut'} or $trouve{'pagefin'}) ) { - $trouve{'titre'} += titre($i1[0], $i2[0], 1); - } - else { - $trouve{'titre'} += titre($i1[0], $i2[0], 0); - } - } - -# Premier auteur -if ( $i1[10] and $i2[10] ) { - $test ++; - if ( $i1[10] eq $i2[10] or - uc($i1[10]) eq uc($i2[10]) ) { - $trouve{'auteur'} ++; - } - } - -my $trouve = scalar keys %trouve; - -if ( $test > 4 and $trouve == $test ) { - return 1; - } - -if ( ($trouve{'ISSN'} or $trouve{'revue'}) and - ($trouve{'date'} or $trouve{'volume'}) and - ($trouve{'pagedebut'} or $trouve{'pagefin'}) and - ($trouve{'auteur'} or $trouve{'titre'}) ) { - return 1; - } - -return 0; -} - -sub revue -{ -my ($title, @liste) = @_; - -my $match = 0; - -my $rv = lc(join(" ", ($title =~ /(\w+)/go))); -foreach my $item (@liste) { - my $jn = decode_entities($item); - if ( $jn eq $title or lc($jn) eq lc($title) ) { - $match ++; - } - else { - my $tmp = lc(join(" ", ($jn =~ /(\w+)/go))); - if ( $tmp eq $rv ) { - $match ++; - } - elsif ( $tmp =~ / [a-z]\z/o and $rv =~ /^$tmp / ) { - $match ++; - } - elsif ( $rv =~ / [a-z]\z/o and $tmp =~ /^$rv / ) { - $match ++; - } - else { - my $tmp1 = join(" ", grep(!/^(and|et|und|e|y)\z/, split(/ +/, $tmp))); - my $tmp2 = join(" ", grep(!/^(and|et|und|e|y)\z/, split(/ +/, $rv))); - if ( $tmp1 eq $tmp2 ) { - $match ++; - } - else { - $tmp1 =~ s/^(the|die|das|les?|la?|du|[ei]l) //o; - $tmp2 =~ s/^(the|die|das|les?|la?|du|[ei]l) //o; - $match ++ if $tmp1 eq $tmp2; - } - } - } - if ( not $match ) { - if ( $jn =~ /\s*: /o ) { - my ($tmp) = ($jn =~ /^(.+)\s*:/o); - if ( $tmp eq $title or lc($tmp) eq lc($title) ) { - $match ++; - } - } - if ( $title =~ /\s*: /o ) { - my ($tmp) = ($title =~ /^(.+)\s*:/o); - if ( $jn eq $tmp or lc($jn) eq lc($tmp) ) { - $match ++; - } - } - } - } - -return $match; -} - -sub biniou -{ -my ($val1, $val2, $champ, $num1, $num2) = @_; - -if ( $val1 =~ /^\d+\z/o ) { - if ( $val2 =~ /^(\d+)[-\x{2010}-\x{2015}\x{2212}](\d+)\z/o ) { - my $inf = $1; - my $sup = $2; - if ( $inf < $sup and $val1 >= $inf and $val1 <= $sup ) { - return 1; - } - } - } -elsif ( $val1 =~ m|^(\d+)[-\x{2010}-\x{2015}\x{2212}/](\d+)\z|o ) { - my $inf = $1; - my $sup = $2; - if ( $val2 =~ /^\d+\z/o ) { - if ( $inf < $sup and $val2 >= $inf and $val2 <= $sup ) { - return 1; - } - } - elsif ( $val2 =~ m|^(\d+)[-\x{2010}-\x{2015}\x{2212}/](\d+)\z|o ) { - my $inf2 = $1; - my $sup2 = $2; - if ( $inf == $inf2 and $sup == $sup2 ) { - return 1; - } - } - } -elsif ( $val1 =~ /^([A-Za-z]+)(\d+)\z/o ) { - my $vl = $1; - my $vn = $2; - if ( $val2 =~ /^([A-Za-z])(\d+)[-\x{2010}-\x{2015}\x{2212}]([A-Za-z])(\d+)\z/o ) { - my $infl = $1; - my $infn = $2; - my $supl = $3; - my $supn = $4; - if ( $infl eq $supl ) { - if ( $vl eq $infl and $vn >= $infn and $vn <= $supl ) { - return 1; - } - } - elsif ( $infl lt $supl ) { - if ( $vl eq $infl and $vn >= $infn ) { - return 1; - } - if ( $vl eq $supl and $vn <= $supn ) { - return 1; - } - if ( $vl gt $infl and $vl lt $supl ) { - return 1 - } - } - else { - alerte("FORMAT $champ \"$num2\" BIZARRE \"$val2\"") - } - } - } -elsif ( $val1 =~ /^([A-Za-z])(\d+)[-\x{2010}-\x{2015}\x{2212}]([A-Za-z])(\d+)\z/o ) { - my $infl = $1; - my $infn = $2; - my $supl = $3; - my $supn = $4; - if ( $val2 =~ /^([A-Za-z]+)(\d+)\z/o ) { - my $vl = $1; - my $vn = $2; - if ( $infl eq $supl ) { - if ( $vl eq $infl and $vn >= $infn and $vn <= $supl ) { - return 1; - } - } - elsif ( $infl lt $supl ) { - if ( $vl eq $infl and $vn >= $infn ) { - return 1; - } - if ( $vl eq $supl and $vn <= $supn ) { - return 1; - } - if ( $vl gt $infl and $vl lt $supl ) { - return 1 - } - } - else { - alerte("FORMAT $champ \"$num1\" BIZARRE \"$val1\"") - } - } - } -else { - alerte("FORMAT $champ \"$num1\" INATTENDU \"$val1\""); - if ( $val2 !~ /^\d+\z/o and - $val2 !~ /^([A-Za-z]+)(\d+)\z/o and - $val2 !~ /^(\d+)[-\x{2010}-\x{2015}\x{2212}](\d+)\z/o and - $val2 !~ /^([A-Za-z])(\d+)[-\x{2010}-\x{2015}\x{2212}]([A-Za-z])(\d+)\z/o ) { - alerte("FORMAT $champ \"$num2\" INATTENDU \"$val2\""); - } - } - -return 0; -} - -sub titre -{ -my ($t1, $t2, $sb) = @_; - -if ( $t1 eq $t2 or - lc($t1) eq lc($t2) or - lc(unidecode($t1)) eq lc(unidecode($t2))) { - return 1; - } - -$t2 =~ s|||go; - -my $tmp1 = lc(join(" ", ($t1 =~ /(\w+)/go))); -my $tmp2 = lc(join(" ", ($t2 =~ /(\w+)/go))); - -if ( $tmp1 eq $tmp2 ) { - return 1; - } -elsif ( unidecode($tmp1) eq unidecode($tmp2) ) { - return 1; - } -else { - $tmp1 = unidecode($tmp1); - $tmp2 = unidecode($tmp2); - my $ld = levenshtein_damereau($tmp1, $tmp2); - if ( $ld == 1 and length($tmp2) > 20 ) { - return 1; - } - elsif ( $ld == 2 and length($tmp2) > 40 ) { - return 1; - } - } - -if ( $sb ) { - if ( $tmp1 =~ /\b$tmp2\b/ or $tmp2 =~ /\b$tmp1\b/ ) { - return 0.5; - } - } - -if ( $t1 =~ /: /o or $t2 =~ /: /o ) { - my ($tmp1) = $t1 =~ /^(.+?)\s*: /o; - my ($tmp2) = $t2 =~ /^(.+?)\s*: /o; - if ( $tmp1 eq $tmp2 ) { - return 1; - } - else { - $tmp1 = lc(join(" ", ($tmp1 =~ /(\w+)/go))); - $tmp2 = lc(join(" ", ($tmp2 =~ /(\w+)/go))); - if ( $tmp1 eq $tmp2 ) { - return 1; - } - elsif ( unidecode($tmp1) eq unidecode($tmp2) ) { - return 1; - } - } - } - -## Test partie de titre -($tmp1 = $t1) =~ s/([^\w ])/\\$1/go; -($tmp2 = $t2) =~ s/([^\w ])/\\$1/go; -if ( length($t1) > length($t2) ) { - if ( $tmp1 =~ /^$tmp2\. .+/i ) { - return 0.5; - } - } -elsif ( length($t1) < length($t2) ) { - if ( $tmp2 =~ /^$tmp1\. .+/i ) { - return 0.5; - } - } - -return 0; -} - -sub levenshtein_damereau -{ -my ($s1, $s2) = @_; - -my $len1 = length $s1; -my $len2 = length $s2; - -return $len2 if $len1 == 0; -return $len1 if $len2 == 0; - -my %mat = (); - -for ( my $i = 0 ; $i <= $len1 ; $i ++ ) { - for ( my $j = 0 ; $j <= $len2 ; $j ++ ) { - $mat{$i}{$j} = 0; - $mat{0}{$j} = $j; - } - $mat{$i}{0} = $i; - } - -my @ar1 = split(//, $s1); -my @ar2 = split(//, $s2); - -my $cost = 0; - -for ( my $i = 1 ; $i <= $len1 ; $i ++ ) { - for ( my $j = 1 ; $j <= $len2 ; $j ++ ) { - $cost = $ar1[$i-1] eq $ar2[$j-1] ? 0 : 1; - $mat{$i}{$j} = min ([$mat{$i-1}{$j} + 1, - $mat{$i}{$j-1} + 1, - $mat{$i-1}{$j-1} + $cost]); - if ( $i > 1 and $j > 1 and - $ar1[$i - 1] eq $ar2[$j - 2] and - $ar1[$i - 2] eq $ar2[$j - 1] ) { - $mat{$i}{$j} = min ([$mat{$i}{$j}, $mat{$i-2}{$j-2} + $cost]); - } - } - } - -return $mat{$len1}{$len2}; -} - -sub min -{ -my @liste = @{$_[0]}; -my $min = shift @liste; - -foreach my $i (@liste) { - $min = $i if $i < $min; - } - -return $min; -} - -sub alerte -{ -my $message = shift; - -print LOG "ALERTE : $message\n"; -} - -__DATA__ - -## -## Liste d’entités caractères -## - -## -## NE PAS MODIFIER ! -## -## DO NOT EDIT! -## - -33 excl -34 dquot -35 num -36 dollar -37 percnt -40 lpar -41 rpar -42 ast -43 plus -44 comma -45 hyphen -46 period -47 sol -58 colon -59 semi -61 equals -63 quest -64 commat -91 lsqb -92 bsol -93 rsqb -95 lowbar -96 grave -123 lcub -124 verbar -256 Amacr; -257 amacr; -258 Abreve; -259 abreve; -260 Aogon; -261 aogon; -262 Cacute; -263 cacute; -264 Ccirc; -265 ccirc; -266 Cdot; -267 cdot; -268 Ccaron; -269 ccaron; -270 Dcaron; -271 dcaron; -272 Dstrok; -273 dstrok; -274 Emacr; -275 emacr; -278 Edot; -279 edot; -280 Eogon; -281 eogon; -282 Ecaron; -283 ecaron; -284 Gcirc; -285 gcirc; -286 Gbreve; -287 gbreve; -288 Gdot; -289 gdot; -290 Gcedil; -291 gcedil; -292 Hcirc; -293 hcirc; -294 Hstrok; -295 hstrok; -296 Itilde; -297 itilde; -298 Imacr; -299 imacr; -302 Iogon; -303 iogon; -304 Idot; -305 inodot; -306 IJlig; -307 ijlig; -308 Jcirc; -309 jcirc; -310 Kcedil; -311 kcedil; -312 kgreen; -313 Lacute; -314 lacute; -315 Lcedil; -316 lcedil; -317 Lcaron; -318 lcaron; -319 Lmidot; -320 lmidot; -321 Lstrok; -322 lstrok; -323 Nacute; -324 nacute; -325 Ncedil; -326 ncedil; -327 Ncaron; -328 ncaron; -329 napos; -330 ENG; -331 eng; -332 Omacr; -333 omacr; -336 Odblac; -337 odblac; -340 Racute; -341 racute; -342 Rcedil; -343 rcedil; -344 Rcaron; -345 rcaron; -346 Sacute; -347 sacute; -348 Scirc; -349 scirc; -350 Scedil; -351 scedil; -354 Tcedil; -355 tcedil; -356 Tcaron; -357 tcaron; -358 Tstrok; -359 tstrok; -360 Utilde; -361 utilde; -362 Umacr; -363 umacr; -364 Ubreve; -365 ubreve; -366 Uring; -367 uring; -368 Udblac; -369 udblac; -370 Uogon; -371 uogon; -372 Wcirc; -373 wcirc; -374 Ycirc; -375 ycirc; -377 Zacute; -378 zacute; -379 Zdot; -380 zdot; -381 Zcaron; -382 zcaron; -501 gacute; -711 caron; -728 breve; -729 dot; -730 ring; -731 ogon; -733 dblac; -902 Aacgr; -904 Eacgr; -905 EEacgr; -906 Iacgr; -908 Oacgr; -910 Uacgr; -911 OHacgr; -912 idiagr; -913 Agr; -914 Bgr; -915 Ggr; -916 Dgr; -917 Egr; -918 Zgr; -919 EEgr; -920 THgr; -921 Igr; -922 Kgr; -923 Lgr; -924 Mgr; -925 Ngr; -926 Xgr; -927 Ogr; -928 Pgr; -929 Rgr; -931 Sgr; -932 Tgr; -933 Ugr; -934 PHgr; -935 KHgr; -936 PSgr; -937 OHgr; -938 Idigr; -939 Udigr; -940 aacgr; -941 eacgr; -942 eeacgr; -943 iacgr; -944 udiagr; -945 agr; -946 bgr; -947 ggr; -948 dgr; -949 egr; -950 zgr; -951 eegr; -952 thgr; -953 igr; -954 kgr; -955 lgr; -956 mgr; -957 ngr; -958 xgr; -959 ogr; -960 pgr; -961 rgr; -962 sfgr; -963 sgr; -964 tgr; -965 ugr; -966 phgr; -967 khgr; -968 psgr; -969 ohgr; -970 idigr; -971 udigr; -972 oacgr; -973 uacgr; -974 ohacgr; -977 thetav; -981 phiv; -988 gammad; -1008 kappav; -1009 rhov; -1025 IOcy; -1026 DJcy; -1027 GJcy; -1028 Jukcy; -1029 DScy; -1030 Iukcy; -1031 YIcy; -1032 Jsercy; -1033 LJcy; -1034 NJcy; -1035 TSHcy; -1036 KJcy; -1038 Ubrcy; -1039 DZcy; -1040 Acy; -1041 Bcy; -1042 Vcy; -1043 Gcy; -1044 Dcy; -1045 IEcy; -1046 ZHcy; -1047 Zcy; -1048 Icy; -1049 Jcy; -1050 Kcy; -1051 Lcy; -1052 Mcy; -1053 Ncy; -1054 Ocy; -1055 Pcy; -1056 Rcy; -1057 Scy; -1058 Tcy; -1059 Ucy; -1060 Fcy; -1061 KHcy; -1062 TScy; -1063 CHcy; -1064 SHcy; -1065 SHCHcy; -1066 HARDcy; -1067 Ycy; -1068 SOFTcy; -1069 Ecy; -1070 YUcy; -1071 YAcy; -1072 acy; -1073 bcy; -1074 vcy; -1075 gcy; -1076 dcy; -1077 iecy; -1078 zhcy; -1079 zcy; -1080 icy; -1081 jcy; -1082 kcy; -1083 lcy; -1084 mcy; -1085 ncy; -1086 ocy; -1087 pcy; -1088 rcy; -1089 scy; -1090 tcy; -1091 ucy; -1092 fcy; -1093 khcy; -1094 tscy; -1095 chcy; -1096 shcy; -1097 shchcy; -1098 hardcy; -1099 ycy; -1100 softcy; -1101 ecy; -1102 yucy; -1103 yacy; -1105 iocy; -1106 djcy; -1107 gjcy; -1108 jukcy; -1109 dscy; -1110 iukcy; -1111 yicy; -1112 jsercy; -1113 ljcy; -1114 njcy; -1115 tshcy; -1116 kjcy; -1118 ubrcy; -1119 dzcy; -8196 emsp13; -8197 emsp14; -8199 numsp; -8200 puncsp; -8202 hairsp; -8208 dash; -8211 ndash; -8212 mdash; -8213 horbar; -8214 Verbar; -8229 nldr; -8244 tprime; -8245 bprime; -8257 caret; -8259 hybull; -8411 tdot; -8412 DotDot; -8453 incare; -8459 hamilt; -8463 planck; -8466 lagran; -8467 ell; -8470 numero; -8471 copysr; -8478 rx; -8486 ohm; -8491 angst; -8492 bernou; -8499 phmmat; -8500 order; -8502 beth; -8503 gimel; -8504 daleth; -8531 frac13; -8532 frac23; -8533 frac15; -8534 frac25; -8535 frac35; -8536 frac45; -8537 frac16; -8538 frac56; -8539 frac18; -8540 frac38; -8541 frac58; -8542 frac78; -8597 varr; -8598 nwarr; -8599 nearr; -8600 drarr; -8601 dlarr; -8602 nlarr; -8603 nrarr; -8605 rarrw; -8606 Larr; -8608 Rarr; -8610 larrtl; -8611 rarrtl; -8614 map; -8617 larrhk; -8618 rarrhk; -8619 larrlp; -8620 rarrlp; -8621 harrw; -8622 nharr; -8624 lsh; -8625 rsh; -8630 cularr; -8631 curarr; -8634 olarr; -8635 orarr; -8636 lharu; -8637 lhard; -8638 uharr; -8639 uharl; -8640 rharu; -8641 rhard; -8642 dharr; -8643 dharl; -8644 rlarr2; -8646 lrarr2; -8647 larr2; -8648 uarr2; -8649 rarr2; -8650 darr2; -8651 lrhar2; -8652 rlhar2; -8653 nlArr; -8654 nhArr; -8655 nrArr; -8661 vArr; -8666 lAarr; -8667 rAarr; -8705 comp; -8708 nexist; -8714 epsis; -8717 bepsi; -8720 coprod; -8722 minus; -8723 mnplus; -8724 plusdo; -8726 setmn; -8728 compfn; -8735 ang90; -8737 angmsd; -8738 angsph; -8739 mid; -8740 nmid; -8741 par; -8742 npar; -8750 conint; -8757 becaus; -8765 bsim; -8768 wreath; -8769 nsim; -8771 sime; -8772 nsime; -8775 ncong; -8777 nap; -8778 ape; -8780 bcong; -8782 bump; -8783 bumpe; -8784 esdot; -8785 eDot; -8786 efDot; -8787 erDot; -8788 colone; -8789 ecolon; -8790 ecir; -8791 cire; -8793 wedgeq; -8796 trie; -8802 nequiv; -8806 lE; -8807 gE; -8808 lne; -8809 gne; -8810 Lt; -8811 Gt; -8812 twixt; -8814 nlt; -8815 ngt; -8816 nle; -8817 nge; -8818 lsim; -8819 gsim; -8822 lg; -8823 gl; -8826 pr; -8827 sc; -8828 pre; -8829 sce; -8830 prsim; -8831 scsim; -8832 npr; -8833 nsc; -8837 nsup; -8840 nsube; -8841 nsupe; -8842 subne; -8843 supne; -8846 uplus; -8847 sqsub; -8848 sqsup; -8849 sqsube; -8850 sqsupe; -8851 sqcap; -8852 sqcup; -8854 ominus; -8856 osol; -8857 odot; -8858 ocir; -8859 oast; -8861 odash; -8862 plusb; -8863 minusb; -8864 timesb; -8865 sdotb; -8866 vdash; -8867 dashv; -8868 top; -8871 models; -8872 vDash; -8873 Vdash; -8874 Vvdash; -8876 nvdash; -8877 nvDash; -8878 nVdash; -8879 nVDash; -8882 vltri; -8883 vrtri; -8884 ltrie; -8885 rtrie; -8888 mumap; -8890 intcal; -8891 veebar; -8892 barwed; -8900 diam; -8902 sstarf; -8903 divonx; -8904 bowtie; -8905 ltimes; -8906 rtimes; -8907 lthree; -8908 rthree; -8909 bsime; -8910 cuvee; -8911 cuwed; -8912 Sub; -8913 Sup; -8914 Cap; -8915 Cup; -8916 fork; -8918 ldot; -8919 gsdot; -8920 Ll; -8921 Gg; -8922 leg; -8923 gel; -8924 els; -8925 egs; -8926 cuepr; -8927 cuesc; -8928 npre; -8929 nsce; -8934 lnsim; -8935 gnsim; -8936 prnsim; -8937 scnsim; -8938 nltri; -8939 nrtri; -8940 nltrie; -8941 nrtrie; -8942 vellip; -8966 Barwed; -8972 drcrop; -8973 dlcrop; -8974 urcrop; -8975 ulcrop; -8981 telrec; -8982 target; -8988 ulcorn; -8989 urcorn; -8990 dlcorn; -8991 drcorn; -8994 frown; -8995 smile; -9251 blank; -9416 oS; -9472 boxh; -9474 boxv; -9484 boxdr; -9488 boxdl; -9492 boxur; -9496 boxul; -9500 boxvr; -9508 boxvl; -9516 boxhd; -9524 boxhu; -9532 boxvh; -9552 boxH; -9553 boxV; -9554 boxdR; -9555 boxDr; -9556 boxDR; -9557 boxdL; -9558 boxDl; -9559 boxDL; -9560 boxuR; -9561 boxUr; -9562 boxUR; -9563 boxuL; -9564 boxUl; -9565 boxUL; -9566 boxvR; -9567 boxVr; -9568 boxVR; -9569 boxvL; -9570 boxVl; -9571 boxVL; -9572 boxHd; -9573 boxhD; -9574 boxHD; -9575 boxHu; -9576 boxhU; -9577 boxHU; -9578 boxvH; -9579 boxVh; -9580 boxVH; -9600 uhblk; -9604 lhblk; -9608 block; -9617 blk14; -9618 blk12; -9619 blk34; -9633 squ; -9642 squf; -9645 rect; -9646 marker; -9651 xutri; -9652 utrif; -9653 utri; -9656 rtrif; -9657 rtri; -9661 xdtri; -9662 dtrif; -9663 dtri; -9666 ltrif; -9667 ltri; -9675 cir; -9733 starf; -9734 star; -9742 phone; -9792 female; -9794 male; -9834 sung; -9837 flat; -9838 natur; -9839 sharp; -10003 check; -10007 cross; -10016 malt; -10022 lozf; -10038 sext; -64256 fflig; -64257 filig; -64258 fllig; -64259 ffilig; - -## -## The End! -## diff --git a/generation_tei/README.md b/generation_tei/README.md deleted file mode 100644 index 0b649ce..0000000 --- a/generation_tei/README.md +++ /dev/null @@ -1,113 +0,0 @@ -Génération de fichiers d’enrichissement TEI -=============== - -Programme de génération de fichiers au format TEI pour la base Istex. - -Le programme `alignment2tei.pl` permet, à partir des résultats dédoublonnés de l’alignement Pascal/Francis - Istex, de générer un fichier d’enrichissement au format TEI. Les fichiers ainsi générés peuvent être placés directement dans un système de répertoires à 4 niveaux pour pouvoir intégrer la base **Istex**. - - -### Usage - -```txt - alignment2tei.pl -f (fichier|-) -a fichier_align -d date -v version [ -l log ] - [ -c répertoire_cc ] [ -r (0|1) ] [ -x ] - alignment2tei.pl -h fichier_HFD -a fichier_align -d date -v version [ -l log ] - [ -c répertoire_cc ] [ -r (0|1) ] [ -x ] - alignment2tei.pl -i -``` - -### Options - -```txt - -a indique le nom du fichier résultat de l’alignement (qui peut être un - fichier compressé avec “gzip” ou “bzip2”) - -c indique le nom du répertoire contenant les tables de correspondance - entre codes de classement Pascal ou Francis et verbalisation (“CC” par - défaut) - -d indique la date à laquelle a été fait l’alignement, en utilisant le format - “aaaa-mm-jj” (par ex. “2020-09-28”) - -f indique le nom du fichier de notices Pascal/Francis (qui peut être un - fichier compressé avec “gzip” ou “bzip2”). Pour utiliser l’entrée standard, - mettre un tiret “-” comme argument - -h indique le nom du fichier HFD de notices Pascal/Francis servant d’entrée - au programme - -i affiche cette aide - -l indique le nom du fichier “log” recevant la liste des notices INIST - appariées ainsi que les identifiants des documents ISTEX correspondants - -r crée l'organisation hiérarchique en 4 répertoires d’ISTEX si la valeur - est 1 (valeur par défaut). Autrement, les fichiers sont créés dans le - répertoire courant - -v indique le numéro de version du programme “matchStan2Istex.pl” utilisé - pour réaliser l’alignement - -x accepte comme valides les appariements lorsque la valeur du score est - suivie d’un point d’exclamation (“!”) -``` - - -### Description - -Le programme lit le fichier de résultat de l'alignement, après correction (si nécessaire) et dédoublonnage, établit la liste des notices **Inist** et documents **Istex** appariés et, à partir des informations extraites des notices **Inist**, génère pour chaque document **Istex** un fichier XML au format TEI contenant des données identifiant la notice bibliographique et le document lui-même, ainsi que les codes de classement, avec leur verbalisation en français et en anglais pour chaque niveau hiérarchique du code en question, comme dans l’exemple suivant avec le code `001B30B80P` : - -```xml - - - Physique - - - Physique atomique et moléculaire - - - Propriétés atomiques et interactions avec les photons - - - Interactions des photons avec les atomes - - - Refroidissement optique d'atomes; piégeage - - -``` - -On y trouve aussi les mots-clés extraits de la notice bibliographique, également en français et en anglais, avec pour certains descripteurs leur nature ou fonction, ou leur statut dans la base (i.e. candidat descripteur ou terme libre), comme dans l’exemple suivant : - -```xml - - Lithium - - - - - - Cation - - - - - Constante Rydberg - - - Spectrométrie microonde - - - - - - Candidat descripteur - - - -``` - -Pour verbaliser les codes de classement, le programme utilise plusieurs tables de correspondance, par défaut présentes dans le répertoire `CC` ou dans le répertoire défini par l’option `-c`. Ces tables contiennent : - - - la verbalisation en français et en anglais des différents codes Pascal ou Francis : - - `verbFrancisEn.txt` - - `verbFrancisFr.txt` - - `verbPascalEn.txt` - - `verbPascalFr.txt` - - les équivalences entre codes pour avoir une verbalisation unique quelle que soit la date de production de la notice : - - `equivCCFrancis.txt` - - `equivCCPascal.txt` - - la liste des liens vers l’application Lodex définissant les domaines scientifiques : - - `liensLodex.txt` - diff --git a/generation_tei/alignment2tei.pl b/generation_tei/alignment2tei.pl deleted file mode 100755 index 87b285c..0000000 --- a/generation_tei/alignment2tei.pl +++ /dev/null @@ -1,2027 +0,0 @@ -#!/usr/bin/perl - - -# Déclaration des pragmas -use strict; -use utf8; -use open qw/:std :utf8/; - -# Appel des modules externes de base -use Encode; -use Getopt::Long; - -# Appel des modules spécifiques à l'application -use HTML::Entities qw(decode_entities %entity2char); -## use HTTP::CookieJar::LWP; -use JSON; -## use LWP::UserAgent; -use Text::Unidecode; -## use URI::Encode qw(uri_encode uri_decode); - -my ($programme) = $0 =~ m|^(?:.*/)?(.+)|; -my $substitut = " " x (length($programme) - 2); -my $Version = "1.9.2"; -my $dateModif = "7 Mars 2021"; - -my $usage = "Usage : \n" . - " $programme -f (fichier|-) -a fichier_align -d date -v version [ -l log ] \n" . - " $substitut [ -c répertoire_cc ] [ -r (0|1) ] [ -x ] \n" . - " $programme -h fichier_HFD -a fichier_align -d date -v version [ -l log ] \n" . - " $substitut [ -c répertoire_cc ] [ -r (0|1) ] [ -x ] \n" . - " $programme -i \n"; -$substitut .= " "; - -my $align = undef; -my $cc_dir = "CC"; -my $date = undef; -my $fichier = undef; -my $hfd = undef; -my $info = undef; -my $log = undef; -my $ready = 1; -my $version = undef; -my $xclam = 0; - -eval { - $SIG{__WARN__} = sub {usage(1);}; - GetOptions( - "align=s" => \$align, - "cc_dir=s" => \$cc_dir, - "date=s" => \$date, - "fichier=s" => \$fichier, - "hfd=s" => \$hfd, - "info" => \$info, - "log=s" => \$log, - "ready=i" => \$ready, - "version=s" => \$version, - "xclam" => \$xclam, - ); - }; -$SIG{__WARN__} = sub {warn $_[0];}; - -if ( $info ) { - print " \n"; - print "Programme : \n"; - print " “$programme”, version $Version ($dateModif)\n"; - print " Permet de créer les fichiers d’enrichissement avec les codes de classement \n"; - print " et les mots-clés Pascal ou Francis au format TEI StandOff \n"; - print "\n"; - print $usage; - print "\nOptions : \n"; - print " -a indique le nom du fichier résultat de l’alignement (qui peut être un \n"; - print " fichier compressé avec “gzip” ou “bzip2”) \n"; - print " -c indique le nom du répertoire contenant les tables de correspondance \n"; - print " entre codes et verbalisation \n"; - print " -d indique la date à laquelle a été fait l’alignement, en utilisant le format \n"; - print " “aaaa-mm-jj” (par ex. “2020-09-28”) \n"; - print " -f indique le nom du fichier d’entrée (qui peut être un fichier compressé \n"; - print " avec “gzip” ou “bzip2”). Pour utiliser l’entrée standard, mettre un \n"; - print " tiret “-” comme argument \n"; - print " -h indique le nom du fichier HFD servant d’entrée au programme \n"; - print " -i affiche cette aide \n"; - print " -l indique le nom du fichier “log” contenant la liste des notices INIST \n"; - print " appariées ainsi que les identifiants des documents ISTEX correspondants \n"; - print " -r crée l'organisation hiérarchique en 4 répertoires d’ISTEX si la valeur \n"; - print " est 1 (valeur par défaut). Autrement, les fichiers sont créés dans le \n"; - print " répertoire courant \n"; - print " -v indique le numéro de version du programme “matchStan2Istex.pl” utilisé \n"; - print " pour réaliser l’alignement \n"; - print " -x accepte comme valides les appariements lorsque la valeur du score est \n"; - print " suivie d’un point d’exclamation (“!”) \n"; - print " \n"; - - exit 0; - } - -usage(2) if not $align or not $date or not $version; -usage(2) if not $fichier and not $hfd; -usage(2) if $fichier and $hfd; - -if ( $date !~ /^(\d\d\d\d)-(\d\d)-(\d\d)\z/ ) { - print STDERR "\n"; - print STDERR "$programme : erreur dans le format de la date ! \n"; - print STDERR "$substitut Utilisez le format “aaaa-mm-jj”. \n"; - exit 3; - } - -if ( $version !~ /^\d+\.\d+\.\d+\z/ ) { - print STDERR "\n"; - print STDERR "$programme : erreur dans le format de la version ! \n\n"; - print STDERR "Vérifiez la bonne version avec la commande : “matchStan2Istex.pl -i” \n"; - exit 4; - } - -if ( $cc_dir =~ m|^(.*)/\z| ) { - $cc_dir = $1; - } - -# Variables -my $annee = ""; -my $inist = ""; -my $num = 0; -my @matchs = (); -my @parties = (); -my %base = (); -my %canon = (); -my %classe = (); -my %equiv = (); -my %francis = (); -my %lodex = (); -my %match = (); -my %verb = (); - -# Tables nécessaires aux verbalisation -my $verbPascalFr = "$cc_dir/verbPascalFr.txt"; -my $verbPascalEn = "$cc_dir/verbPascalEn.txt"; -my $verbFrancisFr = "$cc_dir/verbFrancisFr.txt"; -my $verbFrancisEn = "$cc_dir/verbFrancisEn.txt"; -my $equivCCPascal = "$cc_dir/equivCCPascal.txt"; -my $equivCCFrancis = "$cc_dir/equivCCFrancis.txt"; -my $liensLodex = "$cc_dir/liensLodex.txt"; - -# Lecture des tables -open(VPF, "<:utf8", $verbPascalFr) or die "$!,"; -while() { - chomp; - s/\r//go; - my ($code, $intitule) = split(/\t/); - $verb{$code}{'FR'} = $intitule; - } -close VPF; - -open(VPE, "<:utf8", $verbPascalEn) or die "$!,"; -while() { - chomp; - s/\r//go; - my ($code, $intitule) = split(/\t/); - $verb{$code}{'EN'} = $intitule; - } -close VPE; - -open(VFF, "<:utf8", $verbFrancisFr) or die "$!,"; -while() { - chomp; - s/\r//go; - my ($code, $intitule) = split(/\t/); - $verb{$code}{'FR'} = $intitule; - if ( $code =~ /^[567]\d\d\z/o ) { - $francis{$code} ++; - } - } -close VFF; - -open(VFE, "<:utf8", $verbFrancisEn) or die "$!,"; -while() { - chomp; - s/\r//go; - my ($code, $intitule) = split(/\t/); - $verb{$code}{'EN'} = $intitule; - } -close VFE; - -open(EQP, "<:utf8", $equivCCPascal) or die "$!,"; -while() { - chomp; - s/\r//go; - my ($ac, $canon) = split(/\t/); - my ($an, $code) = split(/-/, $ac); - $equiv{'Pascal'}{$an}{$code} = $canon; - $canon{'Pascal'}{$code}{$canon} ++; - } -close EQP; - -open(EQF, "<:utf8", $equivCCFrancis) or die "$!,"; -while() { - chomp; - s/\r//go; - my ($ca, $canon) = split(/\t/); - if ( $canon =~ /^-(.+)/ ) { - $canon = $1; - } -# if ( $canon =~ /^(.+?)-(.+)/o ) { -# $canon = $1.$2; -# } - if ( $canon =~ /^(.+?) (.+)/o ) { - $canon = "$1-$2"; - } - my ($code, $an) = split(/#/, $ca); -# if ( $code =~ /^(.+?)-(.+)/o ) { -# $code = $1.$2; -# } - if ( $code =~ /^(.+?) (.+)/o ) { - $code = "$1-$2"; - } - $equiv{'Francis'}{$an}{$code} = $canon; - } -close EQF; - -open(LDX, "<:utf8", $liensLodex) or die "$!,"; -while() { - chomp; - s/\r//go; - my ($lien, $code, $intitule) = split(/\t/); - $lodex{$code} = $lien; - } -close LDX; - -# Lecture du modèle de fichier -while() { - next if /^\s*$/o; - next if /^#/o; - if ( /^%%\s+partie\s+(\d+)/o ) { - $num = $1; - } - elsif ( /^%%\s+FIN/o ) { - last; - } - else { - $parties[$num] .= $_; - } - } - -# Modification de la date et du numéro de version -$parties[3] =~ s/%DATE%/$date/; -$parties[3] =~ s/%VERSION%/$version/; - -# Complétion de la table des entitées HTML -#foreach my $item (qw/amp gt lt/) { -# delete $entity2char{$item}; -# } -while() { - next if /^\s*$/o; - next if /^#/o; - chomp; - my ($num, $sgml) = split(/\t+/); - next if $entity2char{$sgml}; - $entity2char{$sgml} = chr($num); - } -close DATA; - -my %trans = ( - "205" => 1, - "210" => 1, - "215" => 1, - "220" => 1, - "221" => 1, - "222" => 1, - "223" => 1, - "224" => 1, - "225" => 1, - "226" => 1, - "227" => 1, - "230" => 1, - "235" => 1, - "240" => 1, - "250" => 1, - "260" => 1, - "280" => 1, - "295" => 1, - ); - -my %voc = ( - "2" => "Sciences de la Terre", - "9" => "Traductions", - "X" => "Sciences exactes, Sciences de la vie, Technologies", - "A" => "Art et archéologie", - "B" => "Science administrative", - "C" => "Sciences de l’éducation", - "D" => "Gestion des entreprises", - "E" => "Économie de l’énergie", - "G" => "Bibliographie géographique internationale", - "H" => "Préhistoire et protohistoire", - "I" => "Histoire et sciences de la littérature", - "J" => "Informatique et sciences juridiques", - "L" => "Sciences du langage", - "N" => "Éthnologie", - "P" => "Philosophie", - "R" => "Histoire et sciences des religions", - "S" => "Sociologie", - "T" => "Histoire des sciences et techniques", - "U" => "Amérique latine", - "V" => "Sciences humaines de la santé", - "W" => "Économie générale", - "1" => "Sciences de l’ingénieur", - "3" => "Physique", - ); -my %nfe = ( - "agr" => "Agrovoc descriptor", - "ar" => "Architect", - "cog" => "Geographical coordinate", - "da" => "Anion", - "dc" => "Cation", - "de" => "Enzyme", - "dg" => "Geography", - "dp" => "Psychometrics", - "ds" => "Systematics", - "dw" => "Virus", - "fa" => "Author", - "fc" => "Organic ligand", - "fd" => "Chronology", - "fe" => "Enzyme", - "ff" => "Pesticide", - "fm" => "Methodology", - "fr" => "Medicament", - "fs" => "Site", - "fx" => "Toxic", - "na" => "Anion", - "nb" => "Cited work", - "nc" => "Cation", - "nd" => "Date", - "ne" => "Technique", - "nf" => "Person (human being, divinity)", - "ng" => "Geography", - "ni" => "Matter-Concept", - "nj" => "Organization-Institution", - "nk" => "Chemical compound", - "nl" => "Language", - "nm" => "Disease", - "nn" => "Ethnic group", - "no" => "Celestial body", - "np" => "Psychometric test", - "ns" => "Systematics", - "nt" => "Soil", - "nv" => "Petrography", - "nw" => "Virus", - "nx" => "Stratigraphy", - "ny" => "Paleontology", - "nz" => "Mineralogy", - "sa" => "Works (buildings)", - "si" => "Information system", - "tec" => "Commercial name. Technical name", - "vf" => "Pesticides", - "vk" => "Chemical terms", - "vr" => "Medicaments", - "vx" => "Toxics", - "CD" => "Candidate keyword", - "INC" => "Uncontrolled term", - ); -my %nff = ( - "agr" => "Descripteur Agrovoc", - "ar" => "Architecte", - "cog" => "Coordonnée géographique", - "da" => "Anion", - "dc" => "Cation", - "de" => "Enzyme", - "dg" => "Géographie", - "dp" => "Psychométrie", - "ds" => "Systématique", - "dw" => "Virus", - "fa" => "Auteur", - "fc" => "Coordinat organique", - "fd" => "Chronologie", - "fe" => "Enzyme", - "ff" => "Pesticide", - "fm" => "Méthodologie", - "fr" => "Médicament", - "fs" => "Site", - "fx" => "Toxique", - "na" => "Anion", - "nb" => "Oeuvre citée", - "nc" => "Cation", - "nd" => "Date", - "ne" => "Technique", - "nf" => "Personne (être humain, divinité)", - "ng" => "Géographie", - "ni" => "Matière-Concept", - "nj" => "Organisme-Institution", - "nk" => "Composé chimique", - "nl" => "Langue", - "nm" => "Maladie", - "nn" => "Ethnie", - "no" => "Objet céleste", - "np" => "Test de psychométrie", - "ns" => "Systématique", - "nt" => "Sol", - "nv" => "Pétrographie", - "nw" => "Virus", - "nx" => "Stratigraphie", - "ny" => "Paléontologie", - "nz" => "Minéralogie", - "sa" => "Ouvrages (bâtiments)", - "si" => "Système d'information", - "tec" => "Nom commercial. Nom technique", - "vf" => "Pesticides", - "vk" => "Termes chimiques", - "vr" => "Médicaments", - "vx" => "Toxiques", - "CD" => "Candidat descripteur", - "INC" => "Terme non contrôlé", - ); - -if ( $align =~ /\.gz\z/o ) { - open(INP, "gzip -cd $align |") or die "$!,"; - binmode(INP, ":utf8"); - } -elsif ( $align =~ /\.bz2\z/o ) { - open(INP, "bzip2 -cd $align |") or die "$!,"; - binmode(INP, ":utf8"); - } -else { - open(INP, "<:utf8", $align) or die "$!,"; - } - -if ( $log ) { - open(LOG, ">:utf8", $log) or die "$!,"; - } -else { - open(LOG, ">:utf8", "/dev/null") or die "$!,"; - } - -while() { - if (/^([_.0\*\+]+\x{00A0}*)\t(\d\.\d+)(!?)\t/o) { - my $score = $1; - my $grade = $2; - my $statut = $3; - $statut = undef if not $xclam; - if ( $grade < 3.490 and not $statut ) { - $inist = undef; - next; - } - chomp; - my @champs = split(/\t/); - $inist = $champs[3]; - my $id = $champs[17]; - my $ark = $champs[18]; - my $doi = $champs[19]; - my $pii = $champs[20]; - my $pmid = $champs[21]; - print LOG "$inist\t$grade$statut\t$id\t$ark\t$doi\t$pii\t$pmid\n"; - push(@{$match{$inist}}, "$id\t$ark\t$doi\t$pii\t$pmid"); - } - elsif (/^([_.0\*\+]+\x{00A0}*)\t(\d\.\d+)\W\t/o) { - $inist = undef; - } - elsif ( /^ ~~> \t/o ) { - next if not $inist; - chomp; - my @champs = split(/\t/); - my $id = $champs[5]; - my $ark = $champs[6]; - my $doi = $champs[7]; - my $pii = $champs[8]; - my $pmid = $champs[9]; - print LOG "$inist\t \" \" \t$id\t$ark\t$doi\t$pii\t$pmid\n"; - push(@{$match{$inist}}, "$id\t$ark\t$doi\t$pii\t$pmid"); - } - } -close INP; - -if ( $fichier ) { - if ( $fichier =~ /\.gz\z/o ) { - open(INP, "gzip -cd $fichier |") or die "$!,"; - binmode(INP, ":raw"); - } - elsif ( $fichier =~ /\.bz2\z/o ) { - open(INP, "bzip2 -cd $fichier |") or die "$!,"; - binmode(INP, ":raw"); - } - else { - open(INP, "<:raw", $fichier) or die "$!,"; - } - } -elsif ( $hfd ) { - open(INP, "IhfdCat $hfd |") or die "$!,"; - binmode(INP, ":raw"); - } - -while() { -# ($inist) = m|((?:\d\d\d-)?\d\d-\d+)|o; - ($inist) = m|(.+?)|o; - next if not defined $match{$inist}; - - $annee = undef; - if ( $inist =~ /^(\d\d)-\d+\z/o ) { - $annee = $1; - } - elsif ( $inist =~ /^\d\d\d[-.](\d\d)[-.]\d+\z/o ) { - $annee = $1; - } - else { - print STDERR "N° INIST incorrect \"$inist\"\n"; - } - if ( $annee > 50 ) { - $annee = "19$annee"; - } - else { - $annee = "20$annee"; - } - - my @codes = (); - foreach my $item (m|(.+?)|go) { - if ( $item =~ m|(([567]\d\d)(.*?))(.+?)|o ) { - my $pos = $1; - my $base = $2; - my $code = $3; - if ( $5 ) { - $code = "$4-$5"; - } - elsif ( $codes[$#codes] =~ /^$code/ ) { - next; - } - $codes[$pos] = "$base:$code"; - $base{$code} = "$4"; - $classe{$code} = "$4-$6"; - } - elsif ( $item =~ m|(.+?)|o ) { - my $pos = $1; - my $base = $2; - my $code = $3; - if ( $code =~ /^([567]\d\d)(\w+)\z/o ) { - $code = "$1-$2" if $francis{$1}; - } - elsif ( $code =~ /^(2\d\d)\w*\z/o ) { - next if $trans{$1}; - } - else { - if ( $code =~ /^001B40F30A[12]\z/o ) { - $code .= "0"; - } - elsif ( $code =~ /^002B31\w+\z/o ) { - $code = "002B31"; - } - } - $codes[$pos] = "$base:$code"; - } - elsif ( $item =~ m|(.+?)|o ) { -# my $pos = $1; -# my $base = $2; - my $code = $3; - if ( $code =~ /^[IVXL]+\z/o ) { - if ( $codes[$#codes] =~ /^\w:(([567]\d\d)-?\w+)\z/o ) { - $classe{$1} = "$2-$code"; - } - } - } - } - my %specifiques = (); - my %generiques = (); - foreach my $item (m|(.+?)|go) { - my $langue = ""; - my $numero = ""; - my $ig2 = ""; - my $motcle = ""; - my $type = ""; - my @nf = (); - if ( $item =~ m||o ) { - $langue = $3; - $numero = $1; - $ig2 = $2; - } - if ( $item =~ m|(.+?)|o ) { - $motcle = decode_entities($1); - $motcle =~ s/^\s+//o; - $motcle =~ s/\s+\z//o; - $motcle =~ s/\s\s+/ /go; - } - if ( $item =~ m|.+?|o ) { - next if $item =~ m|PAC|o; - my %tmp = (); - foreach my $nf ($item =~ m|(.+?)|go) { - next if $tmp{$nf} ++; - push(@nf, $nf); - } - } - if ( $item =~ m#(CD|INC)#io ) { - $type = $1; - } - $specifiques{$langue}{$numero}{$motcle}{'voc'} = $ig2; - if ( @nf ) { - push(@{$specifiques{$langue}{$numero}{$motcle}{'nf'}}, @nf); - } - if ( $type ) { - $specifiques{$langue}{$numero}{$motcle}{'type'} = $type; - } - } - foreach my $item (m|(.+?)|go) { - my $langue = ""; - my $numero = ""; - my $ig2 = ""; - my $motcle = ""; - my $type = ""; - my @nf = (); - if ( $item =~ m||o ) { - $langue = $3; - $numero = $1; - $ig2 = $2; - } - if ( $item =~ m|(.+?)|o ) { - $motcle = decode_entities($1); - $motcle =~ s/^\s+//o; - $motcle =~ s/\s+\z//o; - $motcle =~ s/\s\s+/ /go; - } - if ( $item =~ m|.+?|o ) { - my %tmp = (); - foreach my $nf ($item =~ m|(.+?)|go) { - next if $tmp{$nf} ++; - push(@nf, $nf); - } - } - if ( $item =~ m#(CD|INC)#io ) { - $type = $1; - } - $generiques{$langue}{$numero}{$motcle}{'voc'} = $ig2; - if ( @nf ) { - push(@{$generiques{$langue}{$numero}{$motcle}{'nf'}}, @nf); - } - if ( $type ) { - $generiques{$langue}{$numero}{$motcle}{'type'} = $type; - } - } - foreach my $istex (@{$match{$inist}}) { - my ($id, $ark, $doi, $pii, $pmid) = split(/\t/, $istex); - if ( $ready ) { - my $chemin = substr($id, 0, 1); - if ( not -d $chemin ) { - mkdir($chemin, 0755) or die "$!,"; - } - $chemin .= "/" . substr($id, 1, 1); - if ( not -d $chemin ) { - mkdir($chemin, 0755) or die "$!,"; - } - $chemin .= "/" . substr($id, 2, 1); - if ( not -d $chemin ) { - mkdir($chemin, 0755) or die "$!,"; - } - $chemin .= "/$id"; - if ( not -d $chemin ) { - mkdir($chemin, 0755) or die "$!,"; - } - open(TEI, ">:utf8", "$chemin/${id}_ipf.tei") or die "$!,"; - } - else { - open(TEI, ">:utf8", "${id}_ipf.tei") or die "$!,"; - } - print TEI $parties[1]; - my $marge = 24; - print TEI " " x $marge, "$id\n"; - print TEI " " x $marge, "$ark\n"; - print TEI " " x $marge, "$inist\n"; - if ( $doi ) { - print TEI " " x $marge, "$doi\n"; - } - if ( $pii ) { - print TEI " " x $marge, "$pii\n"; - } - if ( $pmid ) { - print TEI " " x $marge, "$pmid\n"; - } - print TEI $parties[3]; - if ( @codes ) { - my @tmp = grep(/:00[12]/o, @codes); - if ( @tmp ) { - @codes = @tmp; - } - (my $tmp = $parties[4]) =~ s/%YEAR%/$annee/; - print TEI $tmp; - my @lignes = codes('FR', @codes); - print TEI @lignes; - print TEI $parties[6]; - ($tmp = $parties[7]) =~ s/%YEAR%/$annee/; - print TEI $tmp; - @lignes = codes('EN', @codes); - print TEI @lignes; - print TEI $parties[9] - # En l’absence de verbalisations espagnoles, - # on ne fait pas (pour l’instant) les parties - # 10 à 12 - } - if ( defined $specifiques{'FRE'} or defined $generiques{'FRE'} ) { - my @lignes = (); - print TEI $parties[13]; - if ( defined $specifiques{'FRE'} ) { - @lignes = motscles('FRE', %specifiques); - print TEI @lignes; - } - if ( defined $generiques{'FRE'} ) { - @lignes = motscles('FRE', %generiques); - print TEI @lignes; - } - print TEI $parties[15] - } - if ( defined $specifiques{'ENG'} or defined $generiques{'ENG'} ) { - my @lignes = (); - print TEI $parties[16]; - if ( defined $specifiques{'ENG'} ) { - @lignes = motscles('ENG', %specifiques); - print TEI @lignes; - } - if ( defined $generiques{'ENG'} ) { - @lignes = motscles('ENG', %generiques); - print TEI @lignes; - } - print TEI $parties[18] - } - if ( defined $specifiques{'SPA'} or defined $generiques{'SPA'} ) { - my @lignes = (); - print TEI $parties[19]; - if ( defined $specifiques{'SPA'} ) { - @lignes = motscles('SPA', %specifiques); - print TEI @lignes; - } - if ( defined $generiques{'SPA'} ) { - @lignes = motscles('SPA', %generiques); - print TEI @lignes; - } - print TEI $parties[21] - } - print TEI $parties[22]; - close TEI; - } - } -close INP; - - -exit 0; - - -sub usage -{ -print STDERR "\n$usage\n"; - -exit shift; -} - -sub niveaux -{ -my $code = shift; - -my @niveaux = (); -$niveaux[0] = 0; - -if ( $code =~ /^2\d\d/o ) { - if ( $code =~ /^(((2\d\d)[A-Z])\d\d)/o ) { - $niveaux[1] = $3; - $niveaux[2] = $2; - $niveaux[3] = $1; - $niveaux[0] = 3; - } - elsif ( $code =~ /^((2\d\d)[A-Z])/o ) { - $niveaux[1] = $2; - $niveaux[2] = $1; - $niveaux[0] = 2; - } - elsif ( $code =~ /^(2\d\d)/o ) { - $niveaux[1] = $1; - $niveaux[0] = 1; - } - } -elsif ( $code =~ /^00[12][A-Z]/o ) { - if ( $code =~ /^(((((((00[12][A-Z])\d\d)[A-Z])\d\d)[A-Z])\d)[A-Z])/o ) { - $niveaux[1] = $7; - $niveaux[2] = $6; - $niveaux[3] = $5; - $niveaux[4] = $4; - $niveaux[5] = $3; - $niveaux[6] = $2; - $niveaux[7] = $1; - $niveaux[0] = 7; - } - elsif ( $code =~ /^((((((00[12][A-Z])\d\d)[A-Z])\d\d)[A-Z])\d)/o ) { - $niveaux[1] = $6; - $niveaux[2] = $5; - $niveaux[3] = $4; - $niveaux[4] = $3; - $niveaux[5] = $2; - $niveaux[6] = $1; - $niveaux[0] = 6; - } - elsif ( $code =~ /^(((((00[12][A-Z])\d\d)[A-Z])\d\d)[A-Z])/o ) { - $niveaux[1] = $5; - $niveaux[2] = $4; - $niveaux[3] = $3; - $niveaux[4] = $2; - $niveaux[5] = $1; - $niveaux[0] = 5; - } - elsif ( $code =~ /^((((00[12][A-Z])\d\d)[A-Z])\d\d)/o ) { - $niveaux[1] = $4; - $niveaux[2] = $3; - $niveaux[3] = $2; - $niveaux[4] = $1; - $niveaux[0] = 4; - } - elsif ( $code =~ /^(((00[12][A-Z])\d\d)[A-Z])/o ) { - $niveaux[1] = $3; - $niveaux[2] = $2; - $niveaux[3] = $1; - $niveaux[0] = 3; - } - elsif ( $code =~ /^((00[12][A-Z])\d\d)/o ) { - $niveaux[1] = $2; - $niveaux[2] = $1; - $niveaux[0] = 2; - } - elsif ( $code =~ /^(00[12][A-Z])/o ) { - $niveaux[1] = $1; - $niveaux[0] = 1; - } - } -elsif ( $code =~ /^([567]\d\d)/o) { - if ( $base{$code} ) { - $niveaux[1] = $base{$code}; - } - else { - $niveaux[1] = $1; - } - $niveaux[0] = 1; - if ( $classe{$code} ) { - $niveaux[2] = $classe{$code}; - $niveaux[0] = 2; - } - if ( $code ne $niveaux[1] ) { - push(@niveaux, $code); - $niveaux[0] ++; - } - } - -return @niveaux; -} - -sub codes -{ -my ($langue, @liste) = @_; - -my $ligne = ""; -my $marge = 16; -my @lignes = (); -my %dejaVu = (); -my %inconnu = (); - -# my $ligne = " " x $marge . "\n"; -# push(@lignes, $ligne); - -foreach my $item (@liste) { - next if not $item; - my ($code) = $item =~ /^.:(.+)/o; - my @niveaux = niveaux($code); - if ( $code =~ /^00[12]/o ) { - for ( my $nb = $niveaux[0] ; $nb > 0 ; $nb -- ) { - my $cc = $niveaux[$nb]; - if ( not defined $equiv{'Pascal'}{$annee}{$cc} and - not defined $verb{$cc} ) { - if ( defined $canon{'Pascal'}{$cc} ) { - my @canon = keys %{$canon{'Pascal'}{$cc}}; - if ( $#canon == 0 ) { - $equiv{'Pascal'}{$annee}{$cc} = $canon[0]; - } - else { - my @items = sort {$canon{'Pascal'}{$b} <=> $canon{'Pascal'}{$a}} @canon; - $equiv{'Pascal'}{$annee}{$cc} = $items[0]; - } - } - else { - $inconnu{$cc} ++; - if ( $nb == $niveaux[0] ) { - $niveaux[0] --; - } - } - } - } - - } - next if $niveaux[0] < 1; - next if $dejaVu{$niveaux[$niveaux[0]]}; - $dejaVu{$niveaux[$niveaux[0]]} ++; - $ligne = " " x $marge . "\n"; - push(@lignes, $ligne); - $marge += 4; - for ( my $nb = 1 ; $nb <= $niveaux[0] ; $nb ++ ) { - my $cc = $niveaux[$nb]; - $ligne = " " x $marge . "$verb{$equiv}{$langue}\n"; - push(@lignes, $ligne); - $ligne = " " x $marge . "\n"; - push(@lignes, $ligne); - } - elsif ( $equiv{'Francis'}{$annee}{$cc} and - $equiv{'Francis'}{$annee}{$cc} ne $cc and - defined $verb{$equiv{'Francis'}{$annee}{$cc}}{$langue} ) { - my $equiv = $equiv{'Francis'}{$annee}{$cc}; - if ( $lodex{$equiv} ) { - $ligne .= " ref=\"$lodex{$equiv}\""; - } - $ligne .= ">\n"; - push(@lignes, $ligne); - $ligne = " " x ($marge + 4) . "$verb{$equiv}{$langue}\n"; - push(@lignes, $ligne); - $ligne = " " x $marge . "\n"; - push(@lignes, $ligne); - } - elsif ( defined $verb{$cc}{$langue} ) { - if ( $lodex{$cc} ) { - $ligne .= " ref=\"$lodex{$cc}\""; - } - $ligne .= ">\n"; - push(@lignes, $ligne); - if ( $inconnu{$cc} ) { - if ( $langue eq 'FR' ) { - $ligne = " " x ($marge + 4) . "Intitulé absent\n"; - } - elsif ( $langue eq 'EN' ) { - $ligne = " " x ($marge + 4) . "Term not available\n"; - } - } - else { - $ligne = " " x ($marge + 4) . "$verb{$cc}{$langue}\n"; - } - push(@lignes, $ligne); - $ligne = " " x $marge . "\n"; - push(@lignes, $ligne); - } - else { - print STDERR "Notice \"$inist\" : pas de verbalisation pour \"$cc\"\n"; - } - } - $marge -= 4; - push(@lignes, " " x $marge . "\n"); - } - -return @lignes -} - -sub motscles -{ -my ($langue, %motscles) = @_; - -my $marge = 20; -my @lignes = (); - -my $rnf = \%nff; -if ( $langue eq 'ENG' ) { - $rnf = \%nfe; - } - -foreach $num (sort {$a <=> $b} keys %{$motscles{$langue}}) { - my ($motcle) = keys %{$motscles{$langue}{$num}}; - my $type = undef; - my @nf = (); - if ( defined $motscles{$langue}{$num}{$motcle}{'type'} ) { - $type = $motscles{$langue}{$num}{$motcle}{'type'}; - } - if ( defined $motscles{$langue}{$num}{$motcle}{'nf'} ) { - @nf = @{$motscles{$langue}{$num}{$motcle}{'nf'}}; - } - my $ligne = " " x $marge . "\n"; - push(@lignes, $ligne); - $ligne = " " x $marge . " $motcle\n"; - push(@lignes, $ligne); - if ( @nf or $type ) { - $marge += 4; -# my $ligne = " " x $marge . "\n"; -# push(@lignes, $ligne); - foreach my $nf (@nf) { - my $intitule = $nf; - if ( defined $rnf->{$nf} ) { - $intitule = $rnf->{$nf}; - } - elsif ( defined $rnf->{lc($nf)} ) { - $intitule = $rnf->{lc($nf)}; - } - elsif ( $nf =~ /^[lqt][1-9]\z/io ) { - next; - } - else { - print STDERR "Notice \"$inist\" : NF \"$nf\" pour "; - print STDERR "mot-clé \"$motcle\"\n"; - next; - } - my $ligne = " " x $marge . "\n"; - push(@lignes, $ligne); - $ligne = " " x ($marge + 4) . "\n"; - push(@lignes, $ligne); - $ligne = " " x ($marge + 8) . "\n"; - push(@lignes, $ligne); - $ligne = " " x ($marge + 4) . "\n"; - push(@lignes, $ligne); - $ligne = " " x ($marge + 4) . "\n"; - push(@lignes, $ligne); - $ligne = " " x ($marge + 8) . "$intitule\n"; - push(@lignes, $ligne); - $ligne = " " x ($marge + 4) . "\n"; - push(@lignes, $ligne); - $ligne = " " x $marge . "\n"; - push(@lignes, $ligne); - } - if ( $type ) { - my $ligne = " " x $marge . "\n"; - push(@lignes, $ligne); - $ligne = " " x ($marge + 4) . "\n"; - push(@lignes, $ligne); - $ligne = " " x ($marge + 8) . "\n"; - push(@lignes, $ligne); - $ligne = " " x ($marge + 4) . "\n"; - push(@lignes, $ligne); - $ligne = " " x ($marge + 4) . "\n"; - push(@lignes, $ligne); - $ligne = " " x ($marge + 8) . "$rnf->{$type}\n"; - push(@lignes, $ligne); - $ligne = " " x ($marge + 4) . "\n"; - push(@lignes, $ligne); - $ligne = " " x $marge . "\n"; - push(@lignes, $ligne); - } -# $ligne = " " x $marge . "\n"; -# push(@lignes, $ligne); - $marge -= 4; - } - $ligne = " " x $marge . "\n"; - push(@lignes, $ligne); - } - -return @lignes; -} - - - -__DATA__ - -%% partie 1 - - - - - - - - Alignement Pascal/Francis — ISTEX - - enrichissement INIST-CNRS - INIST-CNRS - - - - ISTEX - - -

L’élément standOff de ce document est distribué sous licence - Creative Commons 4.0 non transposée (CC BY 4.0)

-

Ce standOff a été créé dans le cadre du projet ISTEX – Initiative - d’Excellence en Information Scientifique et Technique

- - - - - - -%% partie 2 # - - D6F3AA7EDD75E1885C4BB439D518F98194569F42 - 95-0599541 - 6340873 - -%% partie 3 - - - - - - - - - - - - - Alignement Pascal/Francis — Istex - - - -%% partie 4 - - - %YEAR% - - -%% partie 5 # - - - SCIENCES APPLIQUEES. - BATIMENT. TRAVAUX PUBLICS. - Matériaux - - - SCIENCES APPLIQUEES. - INDUSTRIE DES POLYMERES, PEINTURES, BOIS. - Technologie des polymères - - - SCIENCES APPLIQUEES. - INDUSTRIES CHIMIQUE ET PARACHIMIQUE. - Matériaux de construction. Céramique. Verres. - Verres. - Structure, analyse, propriétés - - - SCIENCES APPLIQUEES. - BATIMENT. TRAVAUX PUBLICS. - Calcul des constructions. Sollicitations. - Résistance des matériaux (élasticité, plasticité, flambage, etc.) - - - BATIMENT. TRAVAUX PUBLICS. - - -%% partie 6 - - - - -%% partie 7 - - - %YEAR% - - -%% partie 8 # - - - APPLIED SCIENCES. - BUILDINGS. PUBLIC WORKS. - Materials - - - APPLIED SCIENCES. - POLYMER INDUSTRY, PAINTS, WOOD. - Technology of polymers. - - - APPLIED SCIENCES. - CHEMICAL INDUSTRY AND CHEMICALS. - Building materials. Ceramics. Glasses. - Glasses. - Structure, analysis, properties - - - APPLIED SCIENCES. - BUILDINGS. PUBLIC WORKS. - Structural analysis. Stresses. - Strength of materials (elasticity, plasticity, buckling, etc.) - - - BUILDINGS. PUBLIC WORKS. - - -%% partie 9 - - - - -%% partie 10 - - - - -%% partie 11 # - - - CIENCIAS APLICADAS. - Edificios; Obras publicas - Materiales - - - CIENCIAS APLICADAS. - INDUSTRIA DEL POLIMERO, PINTURAS, MADERAS. - Tecnologia de los polimeros - - - CIENCIAS APLICADAS. - Quimica. Ciencia de los materiales. - Materiales de construcción. Cerámica. Vidrio. - Vidrio - Estructura, análisis, propiedades. - - - CIENCIAS APLICADAS. - Edificios; Obras publicas - Calculo de las construcciones; Solicitaciones - Resistencia de los materiales (elasticidad, plasticidad, pandeo, etc.) - - - Edificios; Obras publicas - - -%% partie 12 - - - - -%% partie 13 - - - - - -%% partie 14 - - - Composite hybride - - - - - - Candidat descripteur - - - - Experience - - Ethylène polymère - - - - - - Composé chimique - - - - Fibre verre - -%% partie 15 - - - -# - - -%% partie 16 - - - - - -%% partie 17 # - - - Hybrid composites - - - - - - Descriptor candidate - - - - - Flexural modulus - - - - - - Uncontrolled index - - - - - Interlaminar shear strength - - - - - - Uncontrolled index - - - - Experiments - - Polyethylenes - - - - - - Chemical compound - - - - Glass fibers - -%% partie 18 - - - - - -%% partie 19 - - - - - -%% partie 20 # - - - Compuesto hibrido - - - - - - Candidato descriptor - - - - Experiencia - - Etileno polímero - - - - - - Compuesto quimico - - - - Fibra vidrio - -%% partie 21 - - - - - -%% partie 22 - - - - -%% FIN - -## -## Liste d’entités caractères -## - -## -## NE PAS MODIFIER ! -## -## DO NOT EDIT! -## - -33 excl -34 dquot -35 num -36 dollar -37 percnt -40 lpar -41 rpar -42 ast -43 plus -44 comma -45 hyphen -46 period -47 sol -58 colon -59 semi -61 equals -63 quest -64 commat -91 lsqb -92 bsol -93 rsqb -95 lowbar -96 grave -123 lcub -124 verbar -125 rcub -256 Amacr; -257 amacr; -258 Abreve; -259 abreve; -260 Aogon; -261 aogon; -262 Cacute; -263 cacute; -264 Ccirc; -265 ccirc; -266 Cdot; -267 cdot; -268 Ccaron; -269 ccaron; -270 Dcaron; -271 dcaron; -272 Dstrok; -273 dstrok; -274 Emacr; -275 emacr; -278 Edot; -279 edot; -280 Eogon; -281 eogon; -282 Ecaron; -283 ecaron; -284 Gcirc; -285 gcirc; -286 Gbreve; -287 gbreve; -288 Gdot; -289 gdot; -290 Gcedil; -291 gcedil; -292 Hcirc; -293 hcirc; -294 Hstrok; -295 hstrok; -296 Itilde; -297 itilde; -298 Imacr; -299 imacr; -302 Iogon; -303 iogon; -304 Idot; -305 inodot; -306 IJlig; -307 ijlig; -308 Jcirc; -309 jcirc; -310 Kcedil; -311 kcedil; -312 kgreen; -313 Lacute; -314 lacute; -315 Lcedil; -316 lcedil; -317 Lcaron; -318 lcaron; -319 Lmidot; -320 lmidot; -321 Lstrok; -322 lstrok; -323 Nacute; -324 nacute; -325 Ncedil; -326 ncedil; -327 Ncaron; -328 ncaron; -329 napos; -330 ENG; -331 eng; -332 Omacr; -333 omacr; -336 Odblac; -337 odblac; -340 Racute; -341 racute; -342 Rcedil; -343 rcedil; -344 Rcaron; -345 rcaron; -346 Sacute; -347 sacute; -348 Scirc; -349 scirc; -350 Scedil; -351 scedil; -354 Tcedil; -355 tcedil; -356 Tcaron; -357 tcaron; -358 Tstrok; -359 tstrok; -360 Utilde; -361 utilde; -362 Umacr; -363 umacr; -364 Ubreve; -365 ubreve; -366 Uring; -367 uring; -368 Udblac; -369 udblac; -370 Uogon; -371 uogon; -372 Wcirc; -373 wcirc; -374 Ycirc; -375 ycirc; -377 Zacute; -378 zacute; -379 Zdot; -380 zdot; -381 Zcaron; -382 zcaron; -501 gacute; -711 caron; -728 breve; -729 dot; -730 ring; -731 ogon; -733 dblac; -902 Aacgr; -904 Eacgr; -905 EEacgr; -906 Iacgr; -908 Oacgr; -910 Uacgr; -911 OHacgr; -912 idiagr; -913 Agr; -914 Bgr; -915 Ggr; -916 Dgr; -917 Egr; -918 Zgr; -919 EEgr; -920 THgr; -921 Igr; -922 Kgr; -923 Lgr; -924 Mgr; -925 Ngr; -926 Xgr; -927 Ogr; -928 Pgr; -929 Rgr; -931 Sgr; -932 Tgr; -933 Ugr; -934 PHgr; -935 KHgr; -936 PSgr; -937 OHgr; -938 Idigr; -939 Udigr; -940 aacgr; -941 eacgr; -942 eeacgr; -943 iacgr; -944 udiagr; -945 agr; -946 bgr; -947 ggr; -948 dgr; -949 egr; -950 zgr; -951 eegr; -952 thgr; -953 igr; -954 kgr; -955 lgr; -956 mgr; -957 ngr; -958 xgr; -959 ogr; -960 pgr; -961 rgr; -962 sfgr; -963 sgr; -964 tgr; -965 ugr; -966 phgr; -967 khgr; -968 psgr; -969 ohgr; -970 idigr; -971 udigr; -972 oacgr; -973 uacgr; -974 ohacgr; -977 thetav; -981 phiv; -988 gammad; -1008 kappav; -1009 rhov; -1025 IOcy; -1026 DJcy; -1027 GJcy; -1028 Jukcy; -1029 DScy; -1030 Iukcy; -1031 YIcy; -1032 Jsercy; -1033 LJcy; -1034 NJcy; -1035 TSHcy; -1036 KJcy; -1038 Ubrcy; -1039 DZcy; -1040 Acy; -1041 Bcy; -1042 Vcy; -1043 Gcy; -1044 Dcy; -1045 IEcy; -1046 ZHcy; -1047 Zcy; -1048 Icy; -1049 Jcy; -1050 Kcy; -1051 Lcy; -1052 Mcy; -1053 Ncy; -1054 Ocy; -1055 Pcy; -1056 Rcy; -1057 Scy; -1058 Tcy; -1059 Ucy; -1060 Fcy; -1061 KHcy; -1062 TScy; -1063 CHcy; -1064 SHcy; -1065 SHCHcy; -1066 HARDcy; -1067 Ycy; -1068 SOFTcy; -1069 Ecy; -1070 YUcy; -1071 YAcy; -1072 acy; -1073 bcy; -1074 vcy; -1075 gcy; -1076 dcy; -1077 iecy; -1078 zhcy; -1079 zcy; -1080 icy; -1081 jcy; -1082 kcy; -1083 lcy; -1084 mcy; -1085 ncy; -1086 ocy; -1087 pcy; -1088 rcy; -1089 scy; -1090 tcy; -1091 ucy; -1092 fcy; -1093 khcy; -1094 tscy; -1095 chcy; -1096 shcy; -1097 shchcy; -1098 hardcy; -1099 ycy; -1100 softcy; -1101 ecy; -1102 yucy; -1103 yacy; -1105 iocy; -1106 djcy; -1107 gjcy; -1108 jukcy; -1109 dscy; -1110 iukcy; -1111 yicy; -1112 jsercy; -1113 ljcy; -1114 njcy; -1115 tshcy; -1116 kjcy; -1118 ubrcy; -1119 dzcy; -8196 emsp13; -8197 emsp14; -8199 numsp; -8200 puncsp; -8202 hairsp; -8208 dash; -8211 ndash; -8212 mdash; -8213 horbar; -8214 Verbar; -8229 nldr; -8244 tprime; -8245 bprime; -8257 caret; -8259 hybull; -8411 tdot; -8412 DotDot; -8453 incare; -8459 hamilt; -8463 planck; -8466 lagran; -8467 ell; -8470 numero; -8471 copysr; -8478 rx; -8486 ohm; -8491 angst; -8492 bernou; -8499 phmmat; -8500 order; -8502 beth; -8503 gimel; -8504 daleth; -8531 frac13; -8532 frac23; -8533 frac15; -8534 frac25; -8535 frac35; -8536 frac45; -8537 frac16; -8538 frac56; -8539 frac18; -8540 frac38; -8541 frac58; -8542 frac78; -8597 varr; -8598 nwarr; -8599 nearr; -8600 drarr; -8601 dlarr; -8602 nlarr; -8603 nrarr; -8605 rarrw; -8606 Larr; -8608 Rarr; -8610 larrtl; -8611 rarrtl; -8614 map; -8617 larrhk; -8618 rarrhk; -8619 larrlp; -8620 rarrlp; -8621 harrw; -8622 nharr; -8624 lsh; -8625 rsh; -8630 cularr; -8631 curarr; -8634 olarr; -8635 orarr; -8636 lharu; -8637 lhard; -8638 uharr; -8639 uharl; -8640 rharu; -8641 rhard; -8642 dharr; -8643 dharl; -8644 rlarr2; -8646 lrarr2; -8647 larr2; -8648 uarr2; -8649 rarr2; -8650 darr2; -8651 lrhar2; -8652 rlhar2; -8653 nlArr; -8654 nhArr; -8655 nrArr; -8661 vArr; -8666 lAarr; -8667 rAarr; -8705 comp; -8708 nexist; -8714 epsis; -8717 bepsi; -8720 coprod; -8722 minus; -8723 mnplus; -8724 plusdo; -8726 setmn; -8728 compfn; -8735 ang90; -8737 angmsd; -8738 angsph; -8739 mid; -8740 nmid; -8741 par; -8742 npar; -8750 conint; -8757 becaus; -8765 bsim; -8768 wreath; -8769 nsim; -8771 sime; -8772 nsime; -8775 ncong; -8777 nap; -8778 ape; -8780 bcong; -8782 bump; -8783 bumpe; -8784 esdot; -8785 eDot; -8786 efDot; -8787 erDot; -8788 colone; -8789 ecolon; -8790 ecir; -8791 cire; -8793 wedgeq; -8796 trie; -8802 nequiv; -8806 lE; -8807 gE; -8808 lne; -8809 gne; -8810 Lt; -8811 Gt; -8812 twixt; -8814 nlt; -8815 ngt; -8816 nle; -8817 nge; -8818 lsim; -8819 gsim; -8822 lg; -8823 gl; -8826 pr; -8827 sc; -8828 pre; -8829 sce; -8830 prsim; -8831 scsim; -8832 npr; -8833 nsc; -8837 nsup; -8840 nsube; -8841 nsupe; -8842 subne; -8843 supne; -8846 uplus; -8847 sqsub; -8848 sqsup; -8849 sqsube; -8850 sqsupe; -8851 sqcap; -8852 sqcup; -8854 ominus; -8856 osol; -8857 odot; -8858 ocir; -8859 oast; -8861 odash; -8862 plusb; -8863 minusb; -8864 timesb; -8865 sdotb; -8866 vdash; -8867 dashv; -8868 top; -8871 models; -8872 vDash; -8873 Vdash; -8874 Vvdash; -8876 nvdash; -8877 nvDash; -8878 nVdash; -8879 nVDash; -8882 vltri; -8883 vrtri; -8884 ltrie; -8885 rtrie; -8888 mumap; -8890 intcal; -8891 veebar; -8892 barwed; -8900 diam; -8902 sstarf; -8903 divonx; -8904 bowtie; -8905 ltimes; -8906 rtimes; -8907 lthree; -8908 rthree; -8909 bsime; -8910 cuvee; -8911 cuwed; -8912 Sub; -8913 Sup; -8914 Cap; -8915 Cup; -8916 fork; -8918 ldot; -8919 gsdot; -8920 Ll; -8921 Gg; -8922 leg; -8923 gel; -8924 els; -8925 egs; -8926 cuepr; -8927 cuesc; -8928 npre; -8929 nsce; -8934 lnsim; -8935 gnsim; -8936 prnsim; -8937 scnsim; -8938 nltri; -8939 nrtri; -8940 nltrie; -8941 nrtrie; -8942 vellip; -8966 Barwed; -8972 drcrop; -8973 dlcrop; -8974 urcrop; -8975 ulcrop; -8981 telrec; -8982 target; -8988 ulcorn; -8989 urcorn; -8990 dlcorn; -8991 drcorn; -8994 frown; -8995 smile; -9251 blank; -9416 oS; -9472 boxh; -9474 boxv; -9484 boxdr; -9488 boxdl; -9492 boxur; -9496 boxul; -9500 boxvr; -9508 boxvl; -9516 boxhd; -9524 boxhu; -9532 boxvh; -9552 boxH; -9553 boxV; -9554 boxdR; -9555 boxDr; -9556 boxDR; -9557 boxdL; -9558 boxDl; -9559 boxDL; -9560 boxuR; -9561 boxUr; -9562 boxUR; -9563 boxuL; -9564 boxUl; -9565 boxUL; -9566 boxvR; -9567 boxVr; -9568 boxVR; -9569 boxvL; -9570 boxVl; -9571 boxVL; -9572 boxHd; -9573 boxhD; -9574 boxHD; -9575 boxHu; -9576 boxhU; -9577 boxHU; -9578 boxvH; -9579 boxVh; -9580 boxVH; -9600 uhblk; -9604 lhblk; -9608 block; -9617 blk14; -9618 blk12; -9619 blk34; -9633 squ; -9642 squf; -9645 rect; -9646 marker; -9651 xutri; -9652 utrif; -9653 utri; -9656 rtrif; -9657 rtri; -9661 xdtri; -9662 dtrif; -9663 dtri; -9666 ltrif; -9667 ltri; -9675 cir; -9733 starf; -9734 star; -9742 phone; -9792 female; -9794 male; -9834 sung; -9837 flat; -9838 natur; -9839 sharp; -10003 check; -10007 cross; -10016 malt; -10022 lozf; -10038 sext; -64256 fflig; -64257 filig; -64258 fllig; -64259 ffilig; - -## -## The End! -##