#!/usr/bin/perl
#-----------------------------------------------------------
# usage : perl parcours-arborescence-fichiers repertoire-a-parcourir rubrique
# Le programme prend en entrée le nom du répertoire-racine contenant les fichiers
# à traiter et le nom de la rubrique à traiter parmi ces fichiers
#méthode 2 : extraction du contenu textuel des balises TITLE et DESCRIPTION avec la bibliothèque XML::RSS
#-----------------------------------------------------------
use XML::RSS;
use Unicode::String qw(utf8);
my $rep="$ARGV[0]";
my $rubrique="$ARGV[1]";
# On s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
# Initialisation des fichiers de sortie
open(OUT,">>:encoding(utf-8)","sortie-xmlrss_$rubrique.txt");
open(OUTXML,">>:encoding(utf-8)","sortie-xmlrss_$rubrique.xml");
print OUTXML "\n";
print OUTXML "\n";
#-------------------------------------
&parcoursarborescencefichiers($rep); #recursivité!
#-------------------------------------
print OUTXML "\n";
close(OUT);
close(OUTXML);
#-------------------------------------
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) {
&parcoursarborescencefichiers($file);
}
if (-f $file) {
if ($file =~ m/$rubrique.+\.xml$/) {
print $i++," Traitement de : ",$file,"\n";
open(FIC,"<:encoding(utf8)", $file);
my $rss=new XML::RSS;
eval {$rss->parsefile($file); };
if( $@ ) {
$@ =~ s/at \/.*?$//s; # remove module line number
print STDERR "\nERROR in '$file':\n$@\n";
}
else {
foreach my $item (@{$rss->{'items'}}) {
my $titre=$item->{'title'};
my $description=$item->{'description'};
# Appel du sous-programme de nettoyage
$titre=&nettoyage($titre);
$description=&nettoyage($description);
if (uc($encodage) ne "UTF-8") {utf8($titre);utf8($resume);}
# Ecriture des résultats en sorties
print OUT $titre,"\n";
print OUT $description,"\n";
print OUT "--------------------\n";
print OUTXML "- \n";
print OUTXML "$titre\n";
print OUTXML "$description\n";
print OUTXML "
\n";
}
}
}
}
}
}
#----------------------------------------------------------
sub nettoyage {
my $texte=shift;
$texte=~s/'/'/g;
$texte=~s/"/"/g;
$texte =~ s/<//g;
$texte =~ s/&/&/g;
$texte =~ s/]+>//g;
$texte =~ s/
]+>//g;
$texte =~ s/<\/a>//g;
$texte =~ s/'/'/g;
$texte =~ s/"/"/g;
$texte =~ s/<[^>]+>//g;
return $texte;
}