#/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 1 : extraction du contenu textuel des balises TITLE et DESCRIPTION avec les expressions régulières
#-----------------------------------------------------------
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(utf8)","sortie-slurp_$rubrique.txt");
open(OUTXML,">:encoding(utf8)","sortiexml-slurp_$rubrique.xml");
print OUTXML "\n";
print OUTXML "\n";
my %dico_des_titres=();
#----------------------------------------
&parcoursarborescencefichiers($rep); #recursivité!
#----------------------------------------
print OUTXML "\n";
close OUT;
close OUTXML;
exit;
#----------------------------------------------
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); #recurse!
}
if (-f $file) {
if ($file =~/$rubrique.+xml$/) {
print $i++," Traitement de : ",$file,"\n";
open(FIC,"<:encoding(utf8)",$file);
$/=undef; #ou $\=""
my $textelu=;
close FIC;
while ($textelu=~/- .*?(.+?)<\/title>.+?(.+?)<\/description>/sg) {
my $titre=$1;
my $description=$2;
if (!(exists $dico_des_titres{$titre})) {
$dico_des_titres{$titre}=$description ;
# Appel du sous-programme de nettoyage
($titre,$description)=&nettoyage($titre,$description);
# Ecriture des résultats en sorties
print OUT "TITRE : $titre \n";
print OUT "DESCRIPTION : $description \n";
print OUT "--------------------\n";
print OUTXML "
- \n";
print OUTXML "$titre\n";
print OUTXML "$description\n";
print OUTXML "
\n";
}
}
}
}
}
}
#----------------------------------------------
sub nettoyage {
my $titre = $_[0];
my $description = $_[1];
$titre=~s/^$//;
$description=~s/^$//;
$description=~s/<.+?>//g;
$description=~s/'/'/g;
$description=~s/"/"/g;
$description =~ s/&/&/g;
$titre=~s/<.+?>//g;
$titre =~ s/&/&/g;
$titre=~s/'/'/g;
$titre=~s/"/"/g;
$titre=~s/$/\./g;
return $titre,$description;
}