BàO 1 : Parcours+Extraction
I. Spécification
Boîte à Outils série 1
- Parcours du Fils RSS du Monde 2017
- Extraction des contenus textuels
Données
- Entrée : Fils RSS du Monde 2017 (fichiers XML)
- Sortie : Tous les titres et descriptions d'une rubrique stockés dans un fichier txt et un fichier XML
II. Méthodes et Outils
2.1 Méthodes de Parcours de l'arborescence
2.1.1 Parcours récursif
Parcours récursif d'arborescence de répertoire a beaucoup de mérites : l'algorithme est facile à comprendre, le code est lisible, et la performance est assez satisfaisante.
sub parcourirRecursion
{
my ($path)=@_;
opendir(my $dir, $path) or die "ERR : Echec d'ouverture de $path: $!\n";
my @files=readdir($dir);
closedir($dir);
foreach my $file (@files)
{
next if $file =~ /^\.\.?$/;
$file=$path."/".$file;
if ( -d $file ) { parcourirRecursion($file); }
if ( -f $file and $file=~ m/-$rubrique.+\.xml$/ )
{
$fileid++;
# trois moyens d'extraction
# extraireXPath($file);
extraireRSS($file);
# extraireRegex($file);
}
}
}
2.1.2 Parcours non-récursif (pile)
Néanmoins, comme le programme parcourt l'arborsecence en profondeur et utilise pile pour stocker les variables, quand on essaye de parcourir une arborsecence à grande profondeur avec une mémoire insuffisante, on risque d'épuiser la mémoire. Ainsi, on rencontra le fameux stack overflow (on aime le site, mais pas l'erreur). Le programme s'arrêterait avant de finir le parcours.
There's more than one way to do it.
Bien que nous n'avions pas ce problème dans ce projet, nous proposons une autre solution pour parcourir l'arborescence de répertoire. Il s'agit d'une façon non-récursive, qui simule une pile en utilisant la structure "tableau" dispensée par Perl.
sub parcourirPile
{
my ($path)=@_;
my @dirs=($path.'/');
while(my $dir=pop(@dirs))
{
my $DH;
unless(opendir($DH, $dir))
{
warn "ERR : échec d'ouverture de $dir: $!\n";
next;
}
foreach my $file (readdir($DH))
{
next if $file =~ /^\.\.?$/;
$file=$dir."/".$file;
if ( -d $file ) { push(@dirs, $file); }
if ( -f $file and $file=~ m/-$rubrique.+\.xml$/ )
{
$fileid++;
# trois moyens d'extraction
# extraireXPath($file);
extraireRSS($file);
# extraireRegex($file);
}
}
closedir($DH);
}
}
2.2 Outils d'extraction des données textuelles
Dans le projet, nous proposons 3 solutions pour extraire des contenus textuels, qui utilisent respectivement le module XML::RSS, le module XML::XPath et les expressions régulières.
2.2.1 Module XML::RSS du Perl
Description : Ce module facilite la création, la mise à jour et l'enregistrement des fichiers RSS.
url : http://search.cpan.org/dist/XML-RSS/lib/XML/RSS.pm
Version 1.60
2.2.2 Module XML::XPath du Perl
Description : Il constitue un ensemble de modules pour analyser et évaluer les instructions XPath. Il a pour but de se conformer exactement à la spécification XPath à l'adresse http://www.w3.org/TR/xpath tout en permettant d'ajouter des extensions sous la forme de fonctions.
url : http://search.cpan.org/~msergeant/XML-XPath-1.13/XPath.pm
Version 1.1.3
2.2.3 Pure Perl : Regex
III. Solution
#!/usr/bin/perl
use strict;
use warnings;
use XML::RSS;
use XML::XPath;
use open IO => ':encoding(UTF-8)';
my $MODIF="2018-05-15";
my $DOC=<<DOCUMENTATION;
____________________________________________________________________________
NOM : Boîte à Outils 1
MODIFICATION :
$MODIF
AUTEURS :
XU Yizhou, JIANG Chunyang
USAGE :
perl Bao_1.pl REPERTOIRE-A-PARCOURIR RUBRIQUE-A-EXTRAIRE
DESCRIPTION:
Le programme prend en entrée le nom du répertoire contenant les
fichiers à traiter
Le programme construit en sortie un fichier de texte bruit,
et un fichier structuré contenant
sur chaque ligne le nom du fichier et le résultat du filtrage :
<fichier \@id \@nom><item \@numero><titre>titre</titre>
<description>description</description></item></fichier>
____________________________________________________________________________
DOCUMENTATION
if (@ARGV!=2) {
die $DOC;
}
my $repertoire=$ARGV[0];
my $rubrique=$ARGV[1];
my %redondance;
my $cmptItem=0;
my $fileid=0;
#-----------------------------------
#normaliser le nom du répertoire
#-----------------------------------
$repertoire=~ s/[\/]$//;
open(my $FHTXT,">","$rubrique-raw.txt");
open(my $FHXML,">","$rubrique-raw.xml");
print $FHXML "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
print $FHXML "<base rubrique=\"$rubrique\" type=\"texte\">\n<entete>\n<auteur>JIANG Chunyang</auteur>\n<auteur>XU Yizhou</auteur>\n</entete>\n<fichiers>\n";
#------------------------------------------------------------------
parcourirRecursion($repertoire);
# parcourirPile($repertoire);
#------------------------------------------------------------------
print $FHXML "</fichiers>\n</base>\n";
close($FHTXT);
close($FHXML);
exit 0;
#------------------------------------------------------------------
#------------------------------------------------------------------
sub parcourirRecursion
{
my ($path)=@_;
opendir(my $dir, $path) or die "ERR : Echec d'ouverture de $path: $!\n";
my @files=readdir($dir);
closedir($dir);
foreach my $file (@files)
{
next if $file =~ /^\.\.?$/;
$file=$path."/".$file;
if ( -d $file ) { parcourirRecursion($file); }
if ( -f $file and $file=~ m/-$rubrique.+\.xml$/ )
{
$fileid++;
# trois moyens d'extraction
# extraireXPath($file);
extraireRSS($file);
# extraireRegex($file);
}
}
}
#------------------------------------------------------------------
sub parcourirPile
{
my ($path)=@_;
my @dirs=($path.'/');
while(my $dir=pop(@dirs))
{
my $DH;
unless(opendir($DH, $dir))
{
warn "ERR : échec d'ouverture de $dir: $!\n";
next;
}
foreach my $file (readdir($DH))
{
next if $file =~ /^\.\.?$/;
$file=$dir."/".$file;
if ( -d $file ) { push(@dirs, $file); }
if ( -f $file and $file=~ m/-$rubrique.+\.xml$/ )
{
$fileid++;
# trois moyens d'extraction
# extraireXPath($file);
extraireRSS($file);
# extraireRegex($file);
}
}
closedir($DH);
}
}
sub extraireRSS
{
my ($file)=@_;
my $rss=new XML::RSS( encoding => 'utf-8' );
eval { $rss->parsefile($file); };
if ($@) {
warn "ERR: échec d'analyse du fichier $file : $@\n";
}
else
{
print $FHXML "<fichier id=\"$fileid\" nom=\"$file\">\n";
foreach my $item (@{$rss->{'items'}})
{
my $titre=$item->{'title'};
my $description=$item->{'description'};
#---------------------------------
# éliminer des doublons
#---------------------------------
if(not exists $redondance{$titre})
{
$cmptItem++;
$redondance{$titre}=1;
nettoyer(\$titre);
if( $description )
{
nettoyer(\$description);
}else{
$description="";
}
if( not $titre=~ m/[?!.]$/ ){ $titre.='.'; }
print $FHTXT "$titre\n";
print $FHTXT "$description\n\n";
print $FHXML "<item numero=\"$cmptItem\">\n<titre>$titre</titre>\n<description>$description</description>\n</item>\n";
}
}
print $FHXML "</fichier>\n";
}
}
sub extraireXPath
{
my ($file)=@_;
print $FHXML "<fichier id=\"$fileid\" nom=\"$file\">\n";
my $xp=XML::XPath->new( filename => $file );
foreach my $node ($xp->find('/rss/channel/item')->get_nodelist)
{
my $titre=$node->find('title')->string_value;
my $description=$node->find('description')->string_value;
if(not exists $redondance{$titre})
{
$cmptItem++;
$redondance{$titre}=1;
nettoyer(\$titre);
nettoyer(\$description);
if( not $titre=~ m/[?!.]$/ ){ $titre.='.'; }
print $FHTXT "$titre\n";
print $FHTXT "$description\n\n";
print $FHXML "<item numero=\"$cmptItem\">\n<titre>$titre</titre>\n<description>$description</description>\n</item>\n";
}
}
print $FHXML "</fichier>\n";
}
sub extraireRegex
{
my ($file)=@_;
print $FHXML "<fichier id=\"$fileid\" nom=\"$file\">\n";
open (my $FH, "<", $file);
my $texte="";
while (my $ligne=<$FH>)
{
chomp $ligne;
$ligne=~ s/\r//g;
$texte.=$ligne;
}
close($FH);
$texte=~ s/>\s+</></g;
while ($texte=~ m/<item>.+?<title>([^<]*)<\/title>[^<]*<description>([^<]*)<\/description>.+?<\/item>/g)
{
my $titre=$1;
my $description=$2;
if(not exists $redondance{$titre})
{
$cmptItem++;
$redondance{$titre}=1;
nettoyer(\$titre);
nettoyer(\$description);
if( not $titre=~ m/[?!.]$/ ){ $titre.='.'; }
print $FHTXT "$titre\n";
print $FHTXT "$description\n\n";
print $FHXML "<item numero=\"$cmptItem\">\n<titre>$titre</titre>\n<description>$description</description>\n</item>\n";
}
}
print $FHXML "</fichier>\n";
}
sub nettoyer
{
my $contenu=$_[0];
$$contenu =~ s/<[^>]+>//g;
$$contenu =~ s/<.+>//g;
$$contenu =~ s/&(#38;)?#39;/'/g;
$$contenu =~ s/&(#38;)?#34;/"/g;
$$contenu =~ s/&(amp;)?/et/g;
$$contenu =~ s/\x{2019}/\'/g;
}
telecharger