#/usr/bin/perl
#On utilise une bibliothèque permettant de faire des requêtes
use XML::XPath;
use XML::LibXML;
#On utilise une biblioothèque permettant de convertir à l'encodage désiré
use Unicode::String qw(utf8);
use feature "switch";
#################
# DOCUMENTATION #
#################
<<DOC;
PowerTAL!
Février 2011
usage : perl scriptarborescence.pl repertoire-a-parcourir
Le programme prend en entree le nom du repertoire contenant les fichiers à traiter
Le programme demande à l'utilisateur quelle rubrique traiter, seule la rubrique choisie sera traitée.
Le programme construit en sortie plusieurs types de fichiers:
*Le programme construit en sortie un fichier XML structuré comme ci-dessous:
<FICHIERS>
<FICHIER>
<NOM>du fichier</NOM>
<DATE>date</DATE>
<ARTICLES rub="numéro de la rubrique">
<ARTICLE num="numéro de l'article">
<TITRE>Titre de l'article</TITRE>
<RESUME>Résumé de l'article</RESUME>
</ARTICLE>
</ARTICLES>
</FICHIER>
<FICHIER>
...
</FICHIER>
</FICHIERS>
*Le programme construit en sortie un fichier TXT structuré comme ci-dessous:
TITRE: titre de l'article
RESUME: Résumé de l'article
DOC
#-----------------------------------CHOIX DE LA RUBRIQUE-----------------------------------
#On demande à l'utilisateur quelle est a rubrique à traiter
# procédure (num 6) pour démander le choix de la rubrique
&tabloCouleurs;
# on initialise une variable (numéro de la rubrique) récupérée via l'entrée standard
$rub =<STDIN>;
#On enlève le retour chariot
chomp($rub); #à noter que chop($rub) enlèverait aussi le retour chariot, cependant chop enlève le dernier élément quel qu'il soit alors que chomp enlève seulement le retour chariot
# on initialise une variable $numRub et $nomRub qui vont contenir le numéro et le nom de la rubrique
my $nomRub="";
my $numRub="";
#La requête est associée à une rubrique
given ($rub) {
when ($rub eq 1) {$numRub="3208";$nomRub="A_la_une";}
when ($rub eq 2) {$numRub="3210";$nomRub="International";}
when ($rub eq 3) {$numRub="3214";$nomRub="Europe";}
when ($rub eq 5) {$numRub="3224";$nomRub="Opinions";}
when ($rub eq 4) {$numRub="3232";$nomRub="Societe";}
when ($rub eq 6) {$numRub="3236";$nomRub="Medias";}
when ($rub eq 7) {$numRub="3238";$nomRub="Rendez-vous";}
when ($rub eq 8) {$numRub="3242";$nomRub="Sports";}
when ($rub eq 9) {$numRub="3244";$nomRub="Planete";}
when ($rub eq 10) {$numRub="3246";$nomRub="Culture";}
when ($rub eq 11) {$numRub="3260";$nomRub="Livres";}
when ($rub eq 12) {$numRub="3404";$nomRub="Examens";}
when ($rub eq 13) {$numRub="3476";$nomRub="Cinema";}
when ($rub eq 14) {$numRub="3546";$nomRub="Voyage";}
when ($rub eq 15) {$numRub="651865";$nomRub="Technologies";}
default {print "Je n'ai pas compris votre requête\n";}
}
#------------------------------------------------------------------------------------------
#--------------------------------------TRAITEMENT DU RÉPERTOIRE----------------------------
#Le répertoire est celui précisé en premier argument
my $rep="$ARGV[0]";
# on s'assure que le nom du repertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
#------------------------------------------------------------------------------------------
#-----------------------CRÉATION DES FICHIERS EN SORTIE------------------------------------
#On crée un fichier pour chaque sortie différente (TXT, XML)
#traitement de la sortie XML grâce à la librairie XML:LibXML
my $XML="SORTIE-$nomRub.xml";
my $DocXML = XML::LibXML::Document->new( '1.0', 'utf-8' ) or {die "Problème à l'ouverture du fichier $XML"};
$racine = $DocXML->createElement ('FICHIERS');
$DocXML->setDocumentElement ($racine);
my $TXT="SORTIE-$nomRub.txt";
if (!open (FILEOUTTXT,">:encoding(utf-8)", $TXT)) { die "Problème à l'ouverture du fichier $TXT"};
#<!DOCTYPE FICHIERS SYSTEM \"filrss.dtd\">\n<?xml-stylesheet type=\"text/xsl\" href=\"xslprova.xsl\"?>\n<FICHIERS>\n";
#------------------------------------------------------------------------------------------
#------------------LANCEMENT DE LA PROCÉDURE DE PARCOURS SUR LE RÉPERTOIRE-----------------
&parcoursarborescencefichiers($rep);
#fin!
exit;
#------------------------------------------------------------------------------------------
###########################################################################################
# Procédures #
###########################################################################################
#--------------------------PARCOURS DE L'ARBORESCENCE--------------------------------------
#PROCEDURE NUM. 1
sub parcoursarborescencefichiers {
my $path = shift(@_); #SHIFT: retourne la premiere ligne du tableau: "_" contient 2008
opendir(DIR, $path) or die "Je ne peut pas ouvrir $path: $!\n"; # on definit un pointeur de repertoire
#die permet de sortir: comme exit
my @files = readdir(DIR); #lire le contenu du repertoire et utilise le poiteur du repertoire
# renvoie une liste des elements constitutifs des elements du repertoire= @files
closedir(DIR);
foreach $file (@files) {
#chaque element de la liste:un traitement different
next if $file =~ /^\.\.?$/;# passer au suivant si le fichier n'existe pas
$file = $path."/".$file; #heritage du chemin pere
if (-d $file) { #appliquer la fonction si la ressource est un repertoire/un fichier: -d (applique àun repertoire), -f (un fichier)
&parcoursarborescencefichiers($file); #recurse!
}
#On récupère le fichier correspondant à la bonne rubrique et qui finit par .xml
if ((-f $file) && ($file =~ /0,2-$numRub,1-0,0\.xml$/)) {
print "Traitement en cours...\n";
#on lance la proc. num.2 --> le traitement des fichiers
&traiterFichier($file);
}
}
}
#----------------------TRAITEMENT DU FICHIER---------------------------------------
#PROCEDURE NUM. 2
sub traiterFichier{
#On affiche le fichier + compteur sur la console
print "$file : \e[1;31;40m",$i++,"\e[0m\n";
#On ouvre le fichier traité qui pointe sur FILE
#retrait de l'encodage du fichier: procédure num.5
$encodage=&getFileEncoding($file);
#initialisation de l'objet XPath
$xp = XML::XPath->new( filename => $file ) or die "PROBLÈME";
#On stocke dans la varibale le motif de recherche
my $search_path1.="//channel";
#On crée une boucle sur les noeuds
foreach my $noeud1 ( $xp->find($search_path1)->get_nodelist ) {
#On récupère le titre et le résumé de l'item
if (uc($encodage) ne "UTF-8") {utf8($date);}
#Création des balises children dans le document XML
#la balise fichier:
my $fic=$DocXML->createElement("FICHIER");
$racine->addChild($fic);
#le nom du fichier (fils de la balise "FICHIER"):
my $nom=$DocXML->createElement("NOM");
$nom->appendTextNode($file);
$fic->addChild($nom);
#la date (fils de la balise "FICHIER"):
my $date=$noeud1->find('//pubDate')->string_value;
my $dat=$DocXML->createElement("DATE");
$dat->appendTextNode($date);
$fic->addChild($dat);
#la balise ARTICLES (fils de la balise "FICHIER"):
$Rub=$DocXML->createElement("ARTICLES");
$Rub->setAttribute("nom","$nomRub");
$fic->addChild($Rub);
}
#on lance la procédure num. 3
&filtrerTexte($file);
#écriture finale du fichier XML
$DocXML->toFile($XML,1);
}
#--------------------------------FILTRAGE DU TEXTE-----------------------------------------------
#PROCEDURE NUM. 3
#extraction de titre et de description
sub filtrerTexte{
#On initialise un compteur qui va nous permettre d'attribuer un numéro pour chaque article
$i=0;
#On stocke dans la varibale le motif de recherche;
my $search_path.="//item";
#On crée une boucle sur les noeuds
foreach my $noeud ( $xp->find($search_path)->get_nodelist ) {
#On récupère le titre et le résumé de l'item
my $titre=$noeud->find('title')->string_value;
my $resume=$noeud->find('description')->string_value;
if (uc($encodage) ne "UTF-8") {utf8($titre);utf8($resume);}
#On nettoie le titre et le résumé grâce à la procédure nettoietexte
$titre = &nettoietexte($titre);
$resume = &nettoietexte($resume);
#Si la clef du titre n'existe pas et si le titre ne contient rien {INSTRUCTIONS}
if ((!(exists($LISTEXML{$titre})))&&($titre ne "")) {
#On incrémente le compteur
$i++;
#On écrit les sorties nécessaires dans les fichiers txt
print FILEOUTTXT "TITRE : $titre \n";
print FILEOUTTXT "RESUME : $resume \n\n";
#Création des balises fils pour le fichier XML:
#Article (fils de ARTICLES)
my $art=$DocXML->createElement("ARTICLE");
$art->setAttribute("num","$i");
$Rub->addChild($art);
#Titre (fils de ARTICLE)
my $childArt1=$DocXML->createElement("TITRE");
$childArt1->appendTextNode($titre);
$art->addChild($childArt1);
#Resumé (fils de ARTICLE)
my $childArt2=$DocXML->createElement("RESUME");
$childArt2->appendTextNode($resume);
$art->addChild($childArt2);
#On définit à 1 la valeur de la clef de $titre
$LISTEXML{$titre}=1;
}
}
}
#-------------------------NETTOYAGE DU TEXTE-----------------------------------------------
#PROCEDURE NUM. 4
#Ici on nettoye le texte
sub nettoietexte {
my $texte=shift;
$texte =~ s/</</g; #On remplace < par l'élément correspondant
$texte =~ s/>/>/g;
$texte =~ s/<a href[^>]+>//g;
$texte =~ s/<img[^>]+>//g;
$texte =~ s/<\/a>//g;
$texte =~ s/'/'/g;
$texte =~ s/&/&/g;
$texte =~ s/'/'/g;
$texte =~ s/'/'/g;
$texte =~ s/"/"/g;
$texte =~ s/"/"/g;
$texte =~ s/"/"/g;
$texte =~ s/[/[/g;
$texte =~ s/]/]/g;
#$texte =~ s/í/'/g;
$texte =~ s/<[^>]+>//g; #On supprime les balises fermantes
$texte =~ s/ //g; #On supprime les blancs
return $texte;
}
#------------------------------------------------------------------------------------------
#PROCEDURE NUM. 5
#renvoie l'encodage d'un fichier $file
sub getFileEncoding{
$dom = XML::LibXML->load_xml(location => $file );
#$dom est de type Document
#il possède la méthode encoding
my $encodage=$dom->encoding;
print "$encodage / ";
#on vérifie l'encodage
print $dom->actualEncoding."\n";
#renvoi de l'encodage
return $encodage;
}
#------------------------------------------------------------------------------------------
#PROCEDURE NUM. 6
#le choix de la rubrique
sub tabloCouleurs {
print "Quelle rubrique voulez-vous traiter?\n
Tapez sur le numero de la rubrique désirée:\n
\e[1;32;40m1.\e[0m\t\e[1;33;40mA la une\e[0m\t\e[1;32;40m6.\e[0m\t\e[1;33;40mMedias\e[0m\t\t\e[1;32;40m11.\e[0m\t\e[1;33;40mLivres\e[0m\n\e[1;32;40m2.\e[0m\t\e[1;33;40mInternational\e[0m\t\e[1;32;40m7.\e[0m\t\e[1;33;40mRendez-vous\e[0m\t\e[1;32;40m12.\e[0m\t\e[1;33;40mExamens\e[0m\n\e[1;32;40m3.\e[0m\t\e[1;33;40mEurope\e[0m\t\t\e[1;32;40m8.\e[0m\t\e[1;33;40mSports\e[0m\t\t\e[1;32;40m13.\e[0m\t\e[1;33;40mCinema\e[0m\n\e[1;32;40m4.\e[0m\t\e[1;33;40mSociété\e[0m\t\t\e[1;32;40m9.\e[0m\t\e[1;33;40mPlanete\e[0m\t\t\e[1;32;40m14.\e[0m\t\e[1;33;40mVoyages\e[0m\n\e[1;32;40m5.\e[0m\t\e[1;33;40mOpinions\e[0m\t\e[1;32;40m10.\e[0m\t\e[1;33;40mCulture\e[0m\t\t\e[1;32;40m15.\e[0m\t\e[1;33;40mTechnologies\e[0m\n";
}