Boîte à outils 1 : Extraction de données
L'objectif de BàO 1 est de parcourir les répertoires de fichiers RSS et d'extraire par rubrique le titre et la description de chaque article.
Deux solutions pour cette tâche d'extraction de données :
- Script Perl avec l'expression régulière.
- Script Perl avec la bibliothèque XML::LibXML
Parcours de l'arborescence des fils RSS
Le corpus Le Monde RSS de l’année 2016 se compose de plusieurs répertoires organisés en rubriques et date d’aspiration des fils. Pour pouvoir traiter ces fichiers, il faut une partie du script qui parcourt l'arborescence.
#--------------------------------------------------
# La fonction parcours l'arborescence des fichiers
#--------------------------------------------------
sub parcoursarborescencefichiers {
my $path = shift(@_);
opendir(DIR, $path) or die "can't open $path: $!\n";
my @files = readdir(DIR);
closedir(DIR);
foreach my $file (@files) {
next if $file =~ /^\.\.?$/;
$file = $path."/".$file;
if (-d $file) {
print "répertoire courant ==> ",$file,"\n";
&parcoursarborescencefichiers($file);
print "fin de rep ==> ",$file,"\n";
if (-f $file) {
# traitement à effectuer sur le fichier
...
}
}
}
}
Script Perl avec l'expression régulière
Pour extraire les informations que nous souhaitons, nous avons utilisé des expressions régulières afin de récupérer les données liées au titre et description des fils RSS :
$texte=~/<item><title>(.+?)<\/title>.+?<description>(.+?)<\/description>.+?<\/item>/g
La variable $texte va contenir l'extraction des informations retourné par l'expression régulière "(.+?)" qui se trouve entre les balises <title> et <description>
Fonction de nettoyage de données extraite par l'expression régulière :
sub nettoietexte {
my $texte=shift;
$texte=~ s/> +</></g;
$texte=~ s/'/'/g;
$texte=~ s/"/"/g;
$texte=~ s/é/é/g;
$texte=~ s/ê/ê/g;
return $texte;
}
Fonction Perl de parcours de l'arborescence et création des fichiers XML et TXT en full :
#--------------------------------------------------
# La fonction parcours l'arborescence des fichiers
#--------------------------------------------------
sub parcoursarborescencefichiers {
my $path = shift(@_);
opendir(DIR, $path) or die "can't open $path: $!\n";
my @files = readdir(DIR);
closedir(DIR);
foreach my $file (@files) {
next if $file =~ /^\.\.?$/;
$file = $path."/".$file;
if (-d $file) {
print "répertoire courant ==< ",$file,"\n";
&parcoursarborescencefichiers($file);
print "fin de rep ==< ",$file,"\n";
}
if (-f $file) {
if (($file=~/\.xml$/) && ($file!~/\/fil.+\.xml$/)) {
open(FILE, $file);
my $texte="";
while (my $ligne=>FILE<) {
$ligne =~ s/\n//g;
$texte .= $ligne;
}
close(FILE);
$texte=~s/< *>/<>/g;
$texte=~/encoding ?= ?[\'\"]([^\'\"]+)[\'\"]/i;
my $encodage=$1;
print "ENCODAGE : $encodage \n";
if ($encodage ne "") {
while ($texte=~/>item<>title<(.+?)>\/title<.+?>description<(.+?)>\/description<.+?>\/item</g){
my $titre=$1;
my $resume=$2;
$titre = &nettoietexte($1);
$resume = &nettoietexte($2);
my $titreBRUT= encode("iso-8859-1", $titre);
my $resumeBRUT= encode("iso-8859-1", $resume);
print $titreBRUT,"\n";
if (uc($encodage) ne "UTF-8") {utf8($titre);utf8($resume);}
if (!(exists $dico{$titre})){
print FILEOUT2 "TITRE: $titreBRUT \nDESCRIPTION: $resumeBRUT \n\n";
$DUMPFULL=$DUMPFULL.">item<\n";
$DUMPFULL=$DUMPFULL.">title<$titre>/title<\n";
$DUMPFULL=$DUMPFULL.">description<$resume>/description<\n";
$DUMPFULL=$DUMPFULL.">/item<\n";
$dico{$titre}++;
}
}
} else {
print "$file ==< $encodage \n";
}
}
}
}
}
Le programe princiapl :
#/usr/bin/perl
use Unicode::String qw(utf8);
use utf8;
use Encode qw(encode decode);
use warnings;
#-----------------------------------------------------------
# le répertoire parent contenant le flux RSS
my $rep="$ARGV[0]";
# dictionnaire contenant les titres des flux RSS
my $dico={};
# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
# on initialise une variable contenant le flux de sortie XML
my $DUMPFULL="";
# on initialise les noms des deux fichiers en sortie
$output1="./SORTIE/bao1-extract-txt-full.xml";
$output2="./SORTIE/bao1-extract-txt-full.txt";
if (!open (FILEOUT1,">:encoding(utf-8)", $output1)) { die "Pb a l'ouverture du fichier $output1"};
if (!open (FILEOUT2,">:encoding(iso-8859-1)",$output2)) { die "Pb a l'ouverture du fichier $output2"};
#---------------------------------------------------------------------
# appel de la fonction qui parcours l'arborescence des fichiers
&parcoursarborescencefichiers($rep);
# écriture du résulat dans les fichiers txt et xml
print FILEOUT1 "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print FILEOUT1 "<PARCOURS>\n";
print FILEOUT1 "<NOM>Siham Khoufache</NOM>\n";
print FILEOUT1 "<FILTRAGE>\n";
print FILEOUT1 $DUMPFULL;
print FILEOUT1 "</FILTRAGE>\n";
print FILEOUT1 "</PARCOURS>\n";
close(FILEOUT1);
close(FILEOUT2);
exit;
Afin d'extraire les informations par rubrique, nous avons développé une autre fonction qui parcourt l'arborescence et qui construit un dictionnaire centenant toutes les rubriques de notre corpus de travail. Celà nous permettra de récupérer les différents fichiers par rubrique, voici la fonction en question :
sub constructionrubriques {
my $path = shift(@_);
opendir(DIR, $path) or die "can't open $path: $!\n";
my @files = readdir(DIR);
closedir(DIR);
foreach my $file (@files) {
next if $file =~ /^\.\.?$/;
$file = $path."/".$file;
if (-d $file) {
&constructionrubriques($file); #recurse!
}
if (-f $file) {
if (($file=~/\.xml$/) && ($file!~/\/fil.+\.xml$/)) {
open(FILE,$file);
#print "Traitement de :\n$file\n";
my $texte="";
while (my $ligne=<FILE>) {
$ligne =~ s/\n//g;
$texte .= $ligne;
}
close(FILE);
$texte=~s/> *</></g;
# on recherche la rubrique
if ( $txte=~/<channel><title>([^<]+)<\/title>/ ){
my $rubb=$1;
$rubb=~ s/é/e/g;
$rubb=~ s/è/e/g;
$rubb=~ s/ê/e/g;
$rubb=~ s/à/a/g;
$rubb=~ s/Le *Monde *\. *fr *://g;
$rubb=~ s/l'//;
$rubb=~ s/://;
$rubb= NFKD($rubb);
$rubb=~ s/\p{NonspacingMark}//g;
$rubb=~ s/ / /g;
$rubb=~ s/ /-/g;
$rubb= lc($rubb);
$dictionnairesdesrubriques{$rubb}++;
}
}
}
}
}
Fonction qui parcourt l'arborescence et récupère les données par rubrique :
sub parcoursarborescencefichierspourrepererlesrubriques {
my $path = shift(@_);
opendir(DIR, $path) or die "can't open $path: $!\n";
my @files = readdir(DIR);
closedir(DIR);
foreach my $file (@files) {
next if $file =~ /^\.\.?$/;
$file = $path."/".$file;
if (-d $file) {
&parcoursarborescencefichierspourrepererlesrubriques($file); #recurse!
}
if (-f $file) {
if (($file=~/\.xml$/) && ($file!~/\/fil.+\.xml$/)) {
open(FILE, $file);
#print "Traitement de :\n$file\n";
my $texte="";
while (my $ligne=<FILE>) {
$ligne =~ s/\n//g;
$texte .= $ligne;
}
close(FILE);
$texte=~s/> *</></g;
# on recherche la rubrique
if ($texte=~/<channel><title>([^<]+)<\/title>/){
my $rub=$1;
$rub=~s/é/e/gi;
$rub=~s/è/e/gi;
$rub=~s/ê/e/gi;
$rub=~s/à/a/gi;
$rub=~ s/Le *Monde *\. *fr *://gi;
$rub =~ s/l'//;
$rub =~ s/://;
$rub = NFKD($rub);
$rub =~ s/\p{NonspacingMark}//g;
$rub=~ s/ / /g;
$rub=~ s/ /-/g;
$rub=lc($rub);
print "rubrique => $rub \n";
$texte=~/encoding ?= ?[\'\"]([^\'\"]+)[\'\"]/i;
my $encodage=$1;
print "ENCODAGE : $encodage \n";
if ($encodage ne "") {
print "Extraction dans : $file \n";
my $tmptexteBRUT="";
my $tmptexteXML="<file>\n";
$tmptexteXML.="<name>$file</name>\n";
$texte =~ s/> *</></g;
$texte=~/<pubDate>([^<]+)<\/pubDate>/;
$tmptexteXML.="<date>$1</date>\n";
$tmptexteXML.="<items>\n";
$out1="./SORTIE/bao1-extract-txt".$rub.".xml";
$out2="./SORTIE/bao1-extract-txt".$rub.".txt";
if (!open (FOUT1,">>:encoding(utf-8)", $out1)) { die "Pb a l'ouverture du fichier $out1"};
if (!open (FOUT2,">>:encoding(iso-8859-1)",$out2)) { die "Pb a l'ouverture du fichier $out2"};
while ($texte =~ /<item><title>(.+?)<\/title>.+?<description>(.+?)<\/description>/g) {
my $titre=$1;
my $resume=$2;
$titre = &nettoietexte($1);
$resume = &nettoietexte($2);
my $titreBRUT= encode('iso-8859-1', $titre);
my $resumeBRUT= encode('iso-8859-1', $resume);
if (uc($encodage) ne "UTF-8") {utf8($titre);uf8($resume);}
if (!(exists($dictionnairedesitems{$titre}))) {
$tmptexteBRUT.="§ $titreBRUT \n";
$tmptexteBRUT.="$resumeBRUT \n";
$tmptexteXML.="<item><title>$titre</title><abstract>$resume</abstract></item>\n";
$dictionnairedesitems{$titre}++;
}
}
$tmptexteXML.="</items>\n</file>\n";
print FOUT1 $tmptexteXML;
print FOUT2 $tmptexteBRUT;
close FOUT1;
close FOUT2;
}
else {
print "$file ==> $encodage \n";
}
}
}
}
}
}
Programme principal pour le parcours de l'arborescence avec extraction des données par rubrique :
#/usr/bin/perl
use Unicode::String qw(utf8);
use utf8;
use Unicode::Normalize;
use Encode qw(encode decode);
#-----------------------------------------------------------
# le répertoire parent contenant le flux RSS
my $rep="$ARGV[0]";
# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
# on initialise deux dictionnaires, un pour récupérer les rubriques
# et l'autre pour les items
my %dictionnairedesitems=();
my %dictionnairesdesrubriques=();
# on lance la procédure de récupération de la liste des rubriques
&constructionrubriques($rep);
my @liste_rubriques = keys(%dictionnairesdesrubriques);
# construction de la liste des fichiers sortie selon les rubriques
my $output1="";
my $output2="";
foreach my $rub (@liste_rubriques) {
$output1="./SORTIE/bao1-extract-txt".$rub.".xml";
$output2="./SORTIE/bao1-extract-txt".$rub.".txt";
if (!open (FILEOUT1,">:encoding(utf-8)", $output1)) { die "Pb a l'ouverture du fichier $output1"};
if (!open (FILEOUT2,">:encoding(iso-8859-1)",$output2)) { die "Pb a l'ouverture du fichier $output2"};
print FILEOUT1 "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print FILEOUT1 "<PARCOURS>\n";
close FILEOUT1;
close FILEOUT2;
}
# on lance la procédure de parcours des fichiers avec rubrique
&parcoursarborescencefichierspourrepererlesrubriques($rep);
foreach my $rub (@liste_rubriques) {
$output1="./SORTIE/bao1-extract-txt".$rub.".xml";
if (!open (FILEOUT1,">>:encoding(utf-8)", $output1)) { die "Pb a l'ouverture du fichier $output1"};
print FILEOUT1 "</PARCOURS>\n";
close FILEOUT1;
}
#----------------------------------------
exit;
Voici les sorties des fichiers XML et TXT pour les rubriques "International" et "A La Une" suite à l'exécution de programme précédent :
- bao1-extract-txt-international.xml
- bao1-extract-txt-international.txt
- bao1-extract-txt-a-la-une.xml
- bao1-extract-txt-a-la-une.txt
Les fichiers produits XML et TXT seront,respectivement, des entrées pour le proramme Perl treetagger et Cordial de la boîte à outils 2 .
Script Perl avec la bibliothèque XML::LibXML
La bibliothèque XML::LibXML est une interface de la librairie libxml2 écrite en langage de programmation orienté object C, elle fait partie du projet GNOME. Elle permet de parser un document XML avec le nouveau standard DOM (Document Object Model) XML. Nous avons utilisé cette bibliothèque pour parser les fichiers XML en entrée pour en extraire les informations dans les balises TITLE et DESCRIPTION. Voici le programme Perl qui fait appel à cette bibliothèque :
#/usr/bin/perl
use XML::LibXML;
# On vérifie le nombre d'arguments de l'appel au script ($0 : le nom du script)
if($#ARGV=0){
print "usage : perl $0 fichier_tag fichier_motif";
exit;
}
#----------------------------------------------------------------------------------
my $encodagesortiexml="utf-8";
my $encodagesortietxt="iso-8859-1";
open(OUT1,">:encoding($encodagesortietxt)","./SORTIE/bao1-extraction-xmllibxml.txt");
open(OUT2,">:encoding($encodagesortiexml)","./SORTIE/bao1-extraction-xmllibxml.xml");
print OUT2 "<?xml version=\"1.0\" encoding=\"$encodagesortiexml\" ?>\n";
print OUT2 "<file>\n";
print OUT2 "<name>$ARGV[0]</name>\n";
my $input_file= shift @ARGV;
my $parser = XML::LibXML->new();
my $xp = $parser->parse_file($input_file);
# boucle sur les nœud s reconnus du chemin xpath
foreach my $noeud ( $xp->findnodes('//item')->get_nodelist ) {
my $titre=$noeud->findnodes('title')->string_value;
my $resume=$noeud->findnodes('description')->string_value;
$titre=&nettoietexte($titre);
$resume=&nettoietexte($resume);
print OUT1 "Titre : $titre \n";
print OUT1 "Resume : $resume \n";;
print OUT2
"<item><title>$titre</title><abstract>$resume</abstract></item>\n";
}
#----------------------------------------------------------
print OUT2 "</file>\n";
close(OUT1);
close(OUT2);
close(FILE);
exit;
sub nettoietexte {
my $texte=shift;
$texte=~s/'/'/g;
$texte=~s/"/"/g;
$texte =~ s/</</g;
$texte =~ s/>/>/g;
$texte =~ s/<a href[^>]+>//g;
$texte =~ s/<img[^>]+>//g;
$texte =~ s/<\/a>//g;
$texte =~ s/'/'/g;
$texte =~ s/"/"/g;
$texte =~ s/<[^>]+>//g;
return $texte;
}
Voici les sorties des fichiers XML et TXT suite à l'exécution de programme précédent :
Lien vers les scripts Perl
bao1-parcours-arborescence-fichiers.plbao1-parcours-arborescence-fichiers-avec-rubrique.pl
bao1-xmllibxml.pl