#/usr/bin/perl
#ce script récupère les descritpions et titres
#on sépare les tâches pour en faire des fonctions indépendantes à appeler(ex filtrage).
#Le nettoyage est réglé à présent
#le nettoyage des doublons
#le répertoriage par catégorie
#extraction de l'encodage
#création du document structuré en xml : on a mis les titre... sans les baliser
#une nouvelle étape : mange doublon qui reconnaît et supprime les doublons
use HTML::Entities ();
<<DOC;
BASCARANE Lydia & DUBREMETZ Marie
FEVRIER 2011
perl bao1_bascarane_dubremetz.pl 2009
perl bao1_bascarane_dubremetz.pl 2010
Le programme prend en entrée le nom du répertoire contenant les fichiers
à traiter
Le programme construit en sortie un fichier structuré contenant sur chaque
ligne le nom du fichier et le résultat du filtrage :
<FICHIER><NOM>du fichier</NOM></FICHIER><CONTENU>du filtrage</CONTENU></FICHIER>
DOC
#-----------------------------------------------------------
my $rep="$ARGV[0]";
# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
# Initialisation des différentes variables
# numéro & nom de la rubrique, date de l'article traité
my $num="";
my $rubrique="";
my $date="";
my $id="";
my $liste="";
my $annee="";
my $ligne="";
my $jour="";
my $mois="";
my $titre="";
my $contenu="";
my $contenuformate="";
my $contenuxml="";
my $contenutxt="";
my $nomrub="";
my $file="";
my $texte="";
my $DUMPXML="";
my $DUMPTXT="";
my $DUMPLEXICO="";
my $DUMPTMP=""; # afin d'utiliser des balises '<fichier>' et de structurer le tableau des résultats
my $DUMPTMP2=""; # idem, mais pour Cordial (on insère des anotations de début de fichier)
# dialogue avec l'utilisateur
print "\nBienvenue sur le filtreur-nettoyeur de fils RSS \"Le Monde\" !\n\n";
print "Entrez l'identifiant de la rubrique a traiter : \n";
print "0 : A la une\t\t\t\t9 : Opinions\n
1 : International\t\t\t10 : Planete\n
2 : Europe\t\t\t\t11 : Voyages\n
3 : Livres\t\t\t\t12 : Culture\n
4 : Cinema\t\t\t\t13 : Societe\n
5 : Technologies\t\t\t14 : Economie\n
6 : Medias\t\t\t\t15 : Examens\n
7 : Rendez-vous\t\t\t\t16 : Politique\n
8 : Sports\n";
# Récupération de l'identifiant de la rubrique tapé par l'utilisateur
$id = <STDIN>;
# Suppression du dernier caractère de retour à la ligne s'il y en a un
chomp($id);
# Choix de la rubrique
my @liste= ("3208","3210","3260","3476","651865","3236","3238","3242","3232","3244","3546","3246","3224","3234","3404","823353");
if ($id eq 0) {$num="3208";$nomrub="aLaUne"}
elsif ($id eq 1) {$num="3210";$nomrub="international"}
elsif ($id eq 2) {$num="3214";$nomrub="europe"}
elsif ($id eq 3) {$num="3260";$nomrub="livres"}
elsif ($id eq 4) {$num="3476";$nomrub="cinema"}
elsif ($id eq 5) {$num="651865";$nomrub="technologies"}
elsif ($id eq 6) {$num="3236";$nomrub="medias"}
elsif ($id eq 7) {$num="3238";$nomrub="rendezVous"}
elsif ($id eq 8) {$num="3242";$nomrub="sports"}
elsif ($id eq 9) {$num="3232";$nomrub="opinions"}
elsif ($id eq 10) {$num="3244";$nomrub="planete"}
elsif ($id eq 11) {$num="3546";$nomrub="voyages"}
elsif ($id eq 12) {$num="3246";$nomrub="culture"}
elsif ($id eq 13) {$num="3224";$nomrub="societe"}
elsif ($id eq 14) {$num="3234";$nomrub="economie"}
elsif ($id eq 15) {$num="3404";$nomrub="examens_$rep"}
elsif ($id eq 16) {$num="823353";$nomrub="politique"}
else { print "Hum... Je n'ai pas compris : je traiterai donc la rubrique 'A la Une'\n";$num="3208";$nomrub="aLaUne"}
#----------------------------------------
system("mkdir SORTIE_$rep");
my $outputxml="SORTIE_$rep/SORTIE_$nomrub.xml";
my $outputtxt="SORTIE_$rep/SORTIE_$nomrub.txt";
my $outputlexico="SORTIE_$rep/SORTIE_formatlexico3_$nomrub.txt";
my $outputtmp="SORTIE_$rep/SORTIE_txtbaliseTreeTagger_$nomrub.txt";
my $outputtmp2="SORTIE_$rep/SORTIE_txtbaliseCordial_$nomrub.txt";
if (!open (OUTPUTXML,">:encoding(iso-8859-1)","$outputxml")) { die "Pb a l'ouverture du fichier $outputxml"};
if (!open (OUTPUTTXT,">:encoding(iso-8859-1)", "$outputtxt")) { die "Pb a l'ouverture du fichier $outputtxt"};
if (!open (LEXICO,">:encoding(iso-8859-1)", "$outputlexico")) { die "Pb a l'ouverture du fichier $outputlexico"};
if (!open (TMP,">:encoding(iso-8859-1)", "$outputtmp")) { die "Pb a l'ouverture du fichier $outputtmp"};
if (!open (TMP2,">:encoding(iso-8859-1)", "$outputtmp2")) { die "Pb a l'ouverture du fichier $outputtmp2"};
&parcoursarborescencefichiers($rep); #recurse! c'est une procedure qui demarre à partir de notre corpus 2009 et 2010
print OUTPUTXML "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print OUTPUTXML "<PARCOURS>\n";
print OUTPUTXML "<NOM>Votre nom</NOM>\n";
print OUTPUTXML "<FILTRAGE>".$DUMPXML."</FILTRAGE>\n";#$DUMPXML contiendra...
&parcoursarborescencefichiers($rep);
print OUTPUTXML "</PARCOURS>\n";
close(OUTPUTXML);
# sortie au format lexico3 (balises/"clés" spécifiques, format texte)
print LEXICO "<filrss_rubrique=".$nomrub.">\n\n";
print LEXICO "$DUMPLEXICO";
close(LEXICO);
# sortie temporaire pour TreeTagger
print TMP "<$rubrique>\n\n";
print TMP "$DUMPTMP";
close(TMP);
# sortie temporaire pour Cordial
print TMP2 "LIGNEDERUBRIQUE \n\n";
print TMP2 "$DUMPTMP2";
close(TMP2);
#&lancetreetagger;
exit;
# écriture du fichier
#----------------------------------------------
sub parcoursarborescencefichiers {
my $path = shift(@_); #vide la première ligne du tableau: "_" contient 2009 2010
opendir(DIR, $path) or die "can't open $path: $!\n";# definit un pointeur de repertoire
#die permet de sortie: comme exit
my @files = readdir(DIR); #lire le contenu du repertoire et utilise le poiteur du repertoire
# renvoie une liste des elements constitutifs des éléments du repertoire= @files
closedir(DIR);
foreach my $file (@files) { #chaque element de la liste:un traitement différent
next if $file =~ /^\.\.?$/;# passer au suivant si le fichier n'existe pas
$file = $path."/".$file; #héritage du chemin père
if (-d $file) { #appliquer la fct si la ressource est un repertoire/un fichier: -d (applique à un repertoire), -f (un fichier)
&parcoursarborescencefichiers($file); #recurse!
}
my $j=1;
if (-f $file) {
if(($file =~ /0,2-$num,1-0,0\.xml$/) || ($file =~ /0,57-0,64-$num,0\.xml$/)) {
# my $i = $i++
# print "$file :",$i++,"\n";
$DUMPTXT.="$titre1 $description\n";
$DUMPTMP .= "<$file>\n";
$DUMPTMP2 .= "DEBUTDEFICHIER \n";
# parcours du fichier RSS ligne à ligne
while ($ligne = <FICHIER>) {
# Récupération du nom de la rubrique
if ($ligne =~ /<channel><title>(.*?Le Monde\.fr.*?)<\/title><link>/) {
$rubrique = $1;
}
# Récupération de la date de l'article
if ($ligne =~ /<lastBuildDate>(.+200.).+\ ?<\/lastBuildDate>/) {
$date = $1;
# récupération de l'année pour la balise <DESC> de la sortie xml
if ($date =~ /.*(\d+)\s(\w+)\s(20\d\d).*/) {
$jour=$1;
$mois=$2;
$annee=$3;
}
$DUMPXML.="<FICHIER num=\"$i\" date=\"$date\">\n";
$DUMPLEXICO .= "<num_fichier=$i nom_fichier=$file jour=$jour mois=$mois annee=$annee>\n";
}
# séparation par un saut de ligne si deux balises se trouvent sur la même ligne
# (supprime l'ambiguïté d'extraction du contenu des balises voulues)
$ligne =~ s/></>\n</g;
$texte .= $ligne;
}
&filtrage($file);# appel de filtrage
}
}
}
}
#----------------------------------------------
sub filtrage{
#on renvoie la variable $file à l'entrée à l'appel de la fonction :
my $file=shift;
#_______ lecture _______#
open(FILE,$file);
while (my $ligne=<FILE>) {
while ($ligne =~ /\<title\>(.+?)\<\/title\>.+?<description\>(.+?)\<\/description\>.+?<pubDate\>(.+?)<\/pubDate\>/g) {#pour éradiquer le conglomérat 2010 on rajoute "?"
#if (uc($encodage) ne "UTF-8"{utf8($title);utf8($resume);}#formule pour l'encodage à insérer
print "TITRE : $1 \n"; #$1 est le contenu de (,+)
print "DESCRIPTION : $2 \n"; #$2 est le contenu de (,+) entre "description"
print "DATE : $3 \n";#$3 est le contenu entre "pubDate"
my $titre = $1;#on met le contenu de la parenthèse dans une variable locale
my $description = $2; #on met le contenu de la parenthèse dans une variable locale
my $date = $3;#on met le contenu de la parenthèse dans une variable locale
$titre = &nettoietexte($titre);#on appelle la procédure qui va nettoyer le texte des titres de toutes ses entités
$description = &nettoietexte($description);#on appelle la procédure qui va nettoyer le texte de toutes ses entités
$date = &nettoietexte($date);
my $titre1 = &xmlisateur($titre);
my $description1 = &xmlisateur2($description);
my $date1 = &xmlisateur3($date);
#si le texte n'a pas été repéré comme un doublon (cf sub mangedoublon)
if (!($titre =~ /ce doublon s'autodéruira ligne 88 de ce programme/)){
printf (OUTPUTTXT "TITRE : $titre \n"); #on imprime le texte renvoyé dans le doc texte.
$DUMPXML.="$titre1";#mise en variable des titres dans le DUMPXML pour les insérer dans la sortie xml
#$DUMPXML.="<ARTICLE num=\"$j\">\n<TITRE>$titre<\/TITRE>\n$resume\n<\/ARTICLE>\n";
#$DUMPTXT.="$titre $resumetxt\n";
$DUMPTMP.="<BLOC> $titre";
$DUMPTMP2.="BLOCDEPHRASE $titre";
$DUMPLEXICO.="<num_article=$j>\n<titre_num_article=$j>\n$titre1\n\n<resume_num_article=$j>\n$description\n\n\n";
}
if (!($description =~ /ce doublon s'autodéruira ligne 88 de ce programme/)){
printf (OUTPUTTXT "DESCRIPTION : $description\n");#on imprime le texte renvoyé dans le doc texte.
my $description1 = &xmlisateur2($description);
$DUMPXML.="$description1";#mise en variable des descriptions dans le DUMPXML pour les insérer dans la sortie xml
$DUMPTMP.="<BLOC> $description\n";
$DUMPTMP2.="BLOCDEPHRASE $description \n";
}
if (!($date =~ /ce doublon s'autodéruira ligne 88 de ce programme/)){
printf (OUTPUTTXT "DATE : $date \n"); #on imprime le texte renvoyé dans le doc texte.
$DUMPXML.="$date1";#mise en variable des titres dans le DUMPXML pour les insérer dans la sortie xml
#$DUMPXML.="$description1"#mise en variable des descriptions dans le DUMPXML pour les insérer dans la sortie xml
$DUMPTMP.="<BLOC> $date\n";
$DUMPTMP2.="BLOCDEPHRASE $date \n";
}
}
}
}
#-----------------------------------------------------------------------------------------------
#On crée la procédure "nettoyage"
sub nettoietexte {
my $texte=shift;
$texte =~ s/</</g;
$texte =~ s/>/>/g;
$texte =~ s/<a href[^>]+>//g;
$texte =~ s/<img[^>]+>//g;
$texte =~ s/<\/a>//g;
$texte =~ s/&#39;/'/g;
$texte =~ s/&#34;/"/g;
$texte =~ s/#39;/'/g;
$texte =~ s/#34;/"/g;
$texte =~ s/&//g;
$texte =~ s/<[^>]+>//g;
$texte = &mangedoublons($texte);#on appelle la procédure mange doublons
return $texte;
}
my %historique=();#on déclare la table de hashage destinée à stocker tout élément qui a déjà été traité.
sub mangedoublons{
my $texte=shift;#on renvoie texte à la valeur entrée
if (exists($historique{$texte})){ # si la ligne qu'on traite existe déjà dans ma table
#on remplace cette ligne par une chaîne de caractère quelconque :
$texte = "ce doublon s'autodéruira ligne 88 de ce programme";
}
else {
# on entre dans cette boucle si ça n'existe pas encore
my $i++;
# on incrémente le compteur
$historique{$texte}++;
#on ajoute dans historique la ligne
#et on autorise la ligne à revenir dans le traitement
return $texte;
}}
#pour vérifier notre prgramme : si ce mange doublons fait bien son boulot "TITRE : Lemonde.fr" ne devrait plus
#apparaître qu'une seule fois
sub xmlisateur{#on crée la procédure qui mettra les balises
my $texte=shift;
$texte="<title>$texte</title>\n";
return $texte;}
sub xmlisateur2{
my $texte=shift;
$texte="<abstract>$texte</abstract>\n";
return $texte;}
sub xmlisateur3{
my $date=shift;
$date="<date>$date</date>\n";
return $date;}
#______fermeture_____#
close(FILE);
#sub lancetreetagger {
# system("perl TreeTagger/tokenise-fr.pl $outputtmp | treetagger TreeTagger/french-utf8.par -lemma -token -no-unknown -sgml > treetagger.txt");
#}