#/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>(.+?)<\/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 "<item>\n"; print OUTXML "<titre>$titre</titre>\n"; print OUTXML "<description>$description</description>\n"; print OUTXML "</item>\n"; } } } } } } #---------------------------------------------- sub nettoyage { my $titre = $_[0]; my $description = $_[1]; $titre=~s/^<!\[CDATA\[//; $titre=~s/\]\]>$//; $description=~s/^<!\[CDATA\[//; $description=~s/\]\]>$//; $description=~s/<.+?>//g; $description=~s/&#39;/'/g; $description=~s/&#34;/"/g; $description =~ s/&/&/g; $titre=~s/<.+?>//g; $titre =~ s/&/&/g; $titre=~s/&#39;/'/g; $titre=~s/&#34;/"/g; $titre=~s/$/\./g; return $titre,$description; }