Il s'agit ici d'extraire les patrons morpho-syntaxiques à partir des fichiers générés par la boîte à outils 2. Rachid, Jean-Michel et Serge nous ont proposé chacun une script pour ce faire qui s'avèrant être très différents des autres.
Le script de Rachid se sert de XPath pour récupérer les patrons morpho-syntaxiques à partir des fichiers XML produits par TreeTagger et tt2xml-art.pl.
#/usr/bin/perl
# BaO3 - Script de Rachid
<<DOC;
Nom : Rachid Belmouhoub
Avril 2012
usage : perl bao3_rb_new.pl fichier_tag fichier_motif
DOC
use strict;
use utf8;
use XML::LibXML;
# Définition globale des encodage d'entrée et sortie du script à utf8
binmode STDIN, ':encoding(utf8)';
binmode STDOUT, ':encoding(utf8)';
# On vérifie le nombre d'arguments de l'appel au script ($0 : le nom du script)
if($#ARGV!=1){print "usage : perl $0 fichier_tag fichier_motif";exit;}
# Enregistrement des arguments de la ligne de commande dans les variables idoines
my $tag_file= shift @ARGV;
my $patterns_file = shift @ARGV;
# création de l'objet XML::XPath pour explorer le fichier de sortie tree-tagger XML
my $xp = XML::LibXML->new(XML_LIBXML_RECOVER => 2);
$xp->recover_silently(1);
my $dom = $xp->load_xml( location => $tag_file );
my $root = $dom->getDocumentElement();
my $xpc = XML::LibXML::XPathContext->new($root);
# Ouverture du fichiers de motifs
open(PATTERNSFILE, $patterns_file) or die "can't open $patterns_file: $!\n";
# lecture du fichier contenant les motifs, un motif par ligne (par exemple : NOM ADJ)
while (my $ligne = <PATTERNSFILE>) {
# Appel à la procédure d'extraction des motifs
&extract_pattern($ligne);
}
# Fermeture du fichiers de motifs
close(PATTERNSFILE);
# routine de construction des chemins XPath
sub construit_XPath{
# On récupère la ligne du motif recherché
my $local_ligne=shift @_;
# initialisation du chemin XPath
my $search_path="";
# on supprime avec la fonction chomp un éventuel retour à la ligne
chomp($local_ligne);
# on élimine un éveltuel retour chariot hérité de windows
$local_ligne=~ s/\r$//;
# Construction au moyen de la fonction split d'un tableau dont chaque élément a pour valeur un élément du motif recherché
my @tokens=split(/ /,$local_ligne);
# On commence ici la construction du chemin XPath
# Ce chemin correspond au premier noeud "element" de l'arbre XML qui répond au motif cherché
$search_path="//element[contains(data[\@type=\"type\"],\"$tokens[0]\")]";
# Initialisation du compteur pour la boucle de construction du chemin XPath
my $i=1;
while ($i < $#tokens) {
$search_path.="[following-sibling::element[1][contains(data[\@type=\"type\"],\"$tokens[$i]\")]";
$i++;
}
my $search_path_suffix="]";
# on utilise l'opérateur x qui permet de répéter la chaine de caractère à sa gauche autant de fois que l'entier à sa droite,
# soit $i fois $search_path_suffix
$search_path_suffix=$search_path_suffix x $i;
# le chemin XPath final
$search_path.="[following-sibling::element[1][contains(data[\@type=\"type\"],\"".$tokens[$#tokens]."\")]"
.$search_path_suffix;
# print "$search_path\n";
# on renvoie à la procédure appelante le chein XPath et le tableau des éléments du motif
return ($search_path,@tokens);
}
# routine d'extraction du motif
sub extract_pattern{
# On récupère la ligne du motif recherché
my $ext_pat_ligne= shift @_;
# Appel de la fonction construit_XPath pour le motif lu à la ligne courrante du fichier de motif
my ($search_path,@tokens) = &construit_XPath($ext_pat_ligne);
# définition du nom du fichier de résultats pour le motif en utilisant la fonction join
my $match_file = "res_extract-".join('_', @tokens).".txt";
# Ouverture du fichiers de résultats encodé en UTF-8
open(MATCHFILE,">:encoding(UTF-8)", "$match_file") or die "can't open $match_file: $!\n";
# création de l'objet XML::XPath pour explorer le fichier de sortie tree-tagger XML
# Parcours des noeuds du ficher XML correspondant au motif, au moyen de la méthode findnodes
# qui prend pour argument le chemin XPath construit précédement
# avec la fonction "construit_XPath"
my @nodes=$root->findnodes($search_path);
foreach my $noeud ( @nodes) {
# Initialisation du chemin XPath relatif du noeud "data" contenant
# la forme correspondant au premier élément du motif
# Ce chemin est relatif au premier noeud "element" du bloc retourné
# et pointe sur le troisième noeud "data" fils du noeud "element"
# en l'identifiant par la valeur "string" de son attribut "type"
my $form_xpath="";
$form_xpath="./data[\@type=\"string\"]";
# Initialisation du compteur pour la boucle d'éxtraction des formes correspondants
# aux éléments suivants du motif
my $following=0;
# Recherche du noeud data contenant la forme correspondant au premier élément du motif
# au moyen de la fonction "find" qui prend pour arguments:
# 1. le chemin XPath relatif du noeud "data"
# 2. le noeud en cours de traitement dans cette boucle foreach
# la fonction "find" retourne par défaut une liste de noeuds, dans notre cas cette liste
# ne contient qu'un seul élément que nous récupérons avec la fonction "get_node"
# enfin nous en imprimons le contenu textuel au moyen de la méthode string_value
print MATCHFILE $xpc->findvalue($form_xpath,$noeud);
# Boucle d'éxtraction des formes correspondants aux éléments suivants du motif
# On descend dans chaque noeud element du bloc
while ( $following < $#tokens) {
# Incrémentation du compteur $following de cette boucle d'éxtraction des formes
$following++;
# Construction du chemin XPath relatif du noeud "data" contenant
# la forme correspondant à l'élément suivant du motif
# Notez bien l'utilisation du compteur $folowing tant dans la condition de la boucle ci-dessus
# que dans la construction du chemin relatif XPath
my $following_elmt="following-sibling::element[".$following."]";
$form_xpath=$following_elmt."/data[\@type=\"string\"]";
# Impression du contenu textuel du noeud data contenant la forme correspondant à l'élément suivant du motif
print MATCHFILE " ",$xpc->findvalue($form_xpath,$noeud);
# Incrémentation du compteur $following de cette boucle d'éxtraction des formes
# $following++;
}
print MATCHFILE "\n";
}
# Fermeture du fichiers de motifs
close(MATCHFILE);
}
Le script de Jean-Michel fonctionne à partir du fichier Cordial et des patrons morpho-syntaxiques en décomposant les lignes des fichiers générés par Cordial.
#!/usr/bin/perl
# BaO3 - Script de Jean-Michel > Attention les yeux !
# Ouverture du premier argument : le fichier de patrons morphosyntaxiques
open(TERMINO, "<$ARGV[0]");
while(my $terme=<TERMINO>) {
chomp($terme);
$terme =~ s/ +/ /g;
$terme =~ s/\r//g;
open(CORDIAL, "<$ARGV[1]");
my @pos = ();
my @token = ();
# On lit le fichier Cordial jusqu'à tomber sur PCTFAIB ou PCTFORTE
while(my $ligne=<CORDIAL>) {
chomp($ligne);
$ligne =~ s/\r//g;
if ($ligne !~ /PCT/) {
my @liste = split(/\t/, $ligne);
push(@pos, $liste[3]);
push(@token, $liste[1]);
}
else {
print "@token\n";
print "@pos\n";
print "Terme recherché : $terme.\n";
my $a = <STDIN>;
my $pos = join(" ", @pos);
my $token = join(" ", @token);
my $i = 0;
while($pos =~ /$terme/g) {
$i++;
print "Eurêka ! J'ai trouvé $i trucs !\n";
my $avant = $`;
# my $compteurespaces = () = $ligne =~ / /g;
my $espacesterme = 0;
while($terme =~ / /g) {
$espacesterme++;
}
my $comptageespaces = 0;
while($avant =~ / /g) {
$comptageespaces++;
}
for (my $i=$comptageespaces;$i<=$comptageespaces+$espacesterme;$i++) {
print $token[$i]." ";
}
print "\n";
}
@pos=();
@token=();
}
}
close(CORDIAL);
}
close(TERMINO);
exit;
Le script de Serge repose plutôt sur les expressions régulières pour retrouver les patrons morphosyntaxiques (liste @patrons). Ici, l'extraction se fait à partir d'un fichier produit par TreeTagger et tt2xml-art.pl. Pour rechercher les patrons dans un fichier Cordial, il suffit de modifier les expressions régulières.
open(FILE,"$ARGV[0]");
#--------------------------------------------
# le patron cherché ici est du type NOM ADJ";
# le modifier pour extraire NOM PREP NOM
#--------------------------------------------
my @lignes=<FILE>;
close(FILE);
while (@lignes) {
my $ligne=shift(@lignes);
chomp $ligne;
my $sequence="";
my $longueur=0;
if ( $ligne =~ /<element><data type=\"type\">NOM<\/data><data type=\"lemma\">[^<]+<\/data><data type=\"string\">([^<]+)<\/data><\/element>/) {
my $forme=$1;
$sequence.=$forme;
$longueur=1;
my $nextligne=$lignes[0];
if ( $nextligne =~ /<element><data type=\"type\">ADJ<\/data><data type=\"lemma\">[^<]+<\/data><data type=\"string\">([^<]+)<\/data><\/element>/) {
my $forme=$1;
$sequence.=" ".$forme;
$longueur=2;
}
}
if ($longueur == 2) {
print $sequence,"\n";
}
}
En adaptant le script de Serge Fleury et en l'intégrant au script de la BàO2, il m'est dorénavant possible de procéder en une seule commande à la collecte des flux RSS dans un dossier donné, l'extraction dans un fichier texte et un fichier XML du titre et de la description de chaque article par catégorie, l'étiquetage morpho-syntaxique en utilisant TreeTagger et enfin d'extraire des patrons morpho-syntaxiques prédéfinis.
#!/usr/bin/perl
# Importation des bibliothèques
use strict;
use warning;
use XML::RSS;
use utf8;
use HTML::Entities;
# Initialisation des variables
#my $rss = XML::RSS->new(ErrorContext=>2);
#print $rss;
my $rep = "$ARGV[0]";
$rep =~ s/[\/]$//; # On s'assure que le nom du répertoire ne se termine pas par un "/"
my %tableCategories = (); # Tableau - Rubriques
my @tableArticles = (); # Table de hachage - Articles
my $i = 1; # Compteur d'articles lus pour debug
my $nom = "Anaïs Chanclu";
# Fonction de parcours d'arborescence de fichiers
sub scanFiles {
my $path = shift(@_);
opendir(dir, $path) or die "Je n'arrive pas à ouvrir $path : $!\n";
my @files = readdir(dir);
closedir(dir);
foreach my $file (@files) {
next if $file =~ /^\.\.?$/;
$file = $path . "/" .$file;
# Si file est un répertoire, la fonction est alors récursive
if (-d $file) {
&scanFiles($file); # Récursion
}
# Si file est un fichier, on traite le fichier
if (-f $file) {
if ($file =~ /\.xml$/) {
# Vérification de la validité du fichier d'entrée
my $rss = new XML::RSS;
eval { $rss -> parsefile($file); };
open(cr,">>:encoding(utf8)", "script5.cr");
print cr "\nTraitement de '$file':\n$@\n";
close(cr) and next if $@;
# Le fichier est bel et bien un fichier RSS, on poursuit !
# On recupère l'encodage
open(fileItem, $file);
my $encoding = $rss -> {'encoding'};
close(fileItem);
# On recupère le titre du flux selon l'encodage pour avoir la catégorie
open(fileItem, "<:encoding($encoding)", $file);
my $category = $rss -> {'channel'} -> {'title'};
# On nettoie la catégorie
$category = lc($category);
$category =~ s/le monde.fr : //g;
$category =~ s/toute l'actualité sur le monde.fr//g;
$category =~ s/\s//g;
$category =~ s/[,.;:!]//g;
$category =~ s/[éêëè]/e/g;
$category =~ s/[âäà]/a/g;
$category =~ s/[îï]/i/g;
$category =~ s/[ôö]/o/g;
$category =~ s/[ûüù]/u/g;
$category =~ s/[ÿ]/y/g;
# Si la catégorie n'est pas exploitable, on reprend au début de la boucle
open(cr,">>:encoding(utf8)", "script5.cr");
print cr "\nCatégorie ".uc($category)." à traiter...\n";
close(cr) and next if($category eq "") ;
# On initialise les noms des fichiers de sortie
my $outputXml = "sortie-" . $category . ".xml";
my $outputTxt = "sortie-" . $category . ".txt";
my $outputTitle = "title-" . $category . ".tmp" ;
my $outputDesc = "desc-" . $category . ".tmp" ;
my $outCategory = "tag-" . $category . ".xml" ;
# On verifie que la catégorie n'existe pas
if (!(existCategory($category,@tableCategories))) {
# si c'est le cas on l'ajoute
push(@tableCategories,$category);
# On crée un fichier XML vide
open(fileOutXml, ">:encoding(utf-8)", $outputXml) or die "Je n'ai pas réussi à ouvrir le fichier $outputXml !";
print fileOutXml "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print fileOutXml "<PARCOURS>\n";
close(fileOutXml);
# On crée un fichier texte vide
open(fileOutTxt, ">:encoding(utf-8)", $outputTxt) or die "Je n'ai pas réussi à ouvrir le fichier $outputTxt !";
close(fileOutTxt);
# Un fichier tagger XML de tous les articles de la catégorie avec titre et description
open(Sortie, ">:encoding(utf-8)" ,$outCategory) or die "Je n'ai pas réussi à ouvrir le fichier $outCategory !";
print Sortie "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print Sortie "<PARCOURS>\n\t<NOM>$nom</NOM>\n\t<FILTRAGE>\n";
close(Sortie) ;
}
# On récupère le contenu désiré des articles
foreach my $item (@{$rss -> {'items'}}) {
my $tmpTitle = $item -> {'title'};
my $tmpDesc = $item -> {'description'};
# On ne garde que le nécessaire
$tmpDesc =~ s/<p.*?\/>//;
$tmpDesc =~ s/<a href[^>]+>//g;
$tmpDesc =~ s/<img[^>]+>//g;
$tmpDesc =~ s/<\/a>//g;
$tmpDesc =~ s/<[^>]+>//g;
$tmpDesc =~ s/ - Lisez l'intégralité de l'article pour plus d'information./"/g;
# On nettoie le titre et la description
$cleanTitle = decode_entities($tmpTitle);
$cleanDesc = decode_entities($tmpDesc);
# Fichier de compte-rendu
open(cr,">>:encoding(utf8)", "script5.cr");
print cr "$i - $category - $cleanTitle \n";
close(cr);
# On verifie que l'article n'existe pas déjà
if ($tableArticles{$cleanTitle} ne $cleanDesc) {
# S'il n'existe pas, on l'ajoute
$tableArticles{$cleanTitle} .= $cleanDesc;
# On ajoute le titre et la description dans le fichier XML...
open(fileOutXml, ">>:encoding(utf-8)", $outputXml) or die "Je n'ai pas réussi à ouvrir le fichier $outputXml !";
print fileOutXml "<item>\n\t<titre>$cleanTitle</titre>\n\t<description>$cleanDesc</description>\n</item>\n";
close(fileOutXml);
# On prépare l'étiquetage du titre et on initialise outCategory
open(tmpFile, ">:encoding(utf-8)", "tmpTitle.txt");
print tmpFile $cleanTitle;
close(tmpFile);
open(Sortie, ">>:encoding(utf-8)", $outCategory) or die "Je n'ai pas réussi à ouvrir le fichier $outCategory !";
print Sortie "\t\t<item num=\"$i\">\n";
print Sortie "\t\t\t<article>\n";
close(Sortie) ;
# On prépare l'étiquetage de la description
open(tmpFile, ">:encoding(utf-8)", "tmpDesc.txt");
print tmpFile $cleanDesc;
close(tmpFile);
print $i. " - ".$category." - ".$cleanTitle ."\n";
# Étiquetage du titre
open(Sortie, ">>:encoding(utf-8)", $outCategory) or die "Je n'ai pas réussi à ouvrir le fichier $outCategory !";
print Sortie "\t\t\t\t<titre>\n" ;
close(Sortie) ;
system("perl ~/treetagger/tokenise-fr.pl tmpTitle.txt | ~/treetagger/bin/tree-tagger -lemma -token -no-unknown ~/treetagger/lib/french-utf8.par > $outputTitle");
system("perl ./tt2xml-art.pl $outputTitle") ;
my $res = $outputTitle . ".xml" ;
system("cat $res >> $outCategory") ;
open(Sortie, ">>:encoding(utf-8)", $outCategory) or die "Je n'ai pas réussi à ouvrir le fichier $outCategory !";
print Sortie "\t\t\t\t</titre>\n" ;
close(Sortie) ;
# Étiquetage de la description
open(Sortie, ">>:encoding(utf-8)", $outCategory) or die "Je n'ai pas réussi à ouvrir le fichier $outCategory !";
print Sortie "\t\t\t\t<description>\n" ;
close(Sortie) ;
system("perl ~/treetagger/tokenise-fr.pl tmpDesc.txt | ~/treetagger/bin/tree-tagger -lemma -token -no-unknown ~/treetagger/lib/french-utf8.par > $outputDesc");
system("perl ./tt2xml-art.pl $outputDesc") ;
my $res = $outputDesc . ".xml" ;
system("cat $res >> $outCategory") ;
open(Sortie, ">>:encoding(utf-8)", $outCategory) or die "Je n'ai pas réussi à ouvrir le fichier $outCategory !";
print Sortie "\t\t\t\t</description>\n" ;
close(Sortie) ;
# Nettoyage et fermeture des balises article et item
open(Sortie, ">>:encoding(utf-8)", $outCategory) or die "Je n'ai pas réussi à ouvrir le fichier $outCategory !";
print Sortie "\t\t\t</article>\n";
print Sortie "\t\t</item>\n";
close(Sortie) ;
system("rm tmpDesc.txt tmpTitle.txt *.tmp *.tmp.xml");
# ...ainsi que dans le fichier TXT
open(fileOutTxt, ">>:encoding(utf-8)", $outputTxt) or die "Je n'ai pas réussi à ouvrir le fichier $outputTxt !";
print fileOutTxt "§ " . $cleanTitle . "\n" . $cleanDesc ."\n\n";
close(fileOutTxt);
}
$i++; # compteur d'articles
}
close(fileItem);
}
}
}
}
# Fonction de recherche de categorie dans le tableau
sub existCategory {
my ($cat,@tab) = @_;
$res=0 ;
foreach my $c (@tab) {
if ($c eq $cat) {
$res=1;
last;
}
}
return $res;
}
# Fichier de compte-rendu
open(cr,">:encoding(utf8)", "script5.cr");
print cr "Compte-rendu de traitement de script5.pl\n";
close(cr);
# On parcourt les fichiers
&scanFiles($rep);
# Fin de traitement
foreach my $category (@tableCategories) {
# Fermetures des balises des fichiers de sortie par catégorie
my $outputXml = "sortie-" . $category . ".xml";
if (!open (fileOutXml,">>:encoding(utf-8)", $outputXml)) { die "Problème à l'ouverture du fichier $outputXml."};
print fileOutXml "</PARCOURS>\n";
close(fileOutXml);
# Fermetures des balises des fichiers de sortie par catégorie filtrée
my $outCategory = "tag-".$category .".xml";
if (!open (Sortie,">>:encoding(utf-8)", $outCategory)) { die "Problème à l'ouverture du fichier $outCategory."};
print Sortie "\t</FILTRAGE>\n</PARCOURS>\n" ;
close(Sortie) ;
# Extraction de patrons morpho-syntaxiques
my @patrons=("NOM ADJ", "NOM PRP NOM", "ADJ NOM");
foreach my $patron (@patrons) {
$patron =~ s/\s/_/g;
my $outPatron = $category."-".$patron.".txt";
system("perl script2-patron.pl $outCategory $patron > $outPatron");
}
}
exit;