#!/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/&#39;/'/g; $texte =~ s/&#34;/"/g; $texte =~ s/<[^>]+>//g; return $texte; }