Programmation et projet
encadré : BAO

#!/usr/bin/perl
open(FILEINPUT,"$ARGV[0]");
while ($ligne = <FILEINPUT>){
if ($ligne=~/REGEXP/) {
print $ligne;
}
}
close(FILEINPUT) ;

On ouvre le fichier qui est le premier argument en ligne de commande et on l’associe au pointeur FILEINPUT. La boucle While indique que tant qu'il y a quelque chose à lire dans le fichier alors, il faut afficher la ligne que l'on vient de lire uniquement si cette ligne contient le motif de la REGEXP. Pour ne garder que les lignes qui contiennent l'expression régulière, on utilise cette ligne : if ($ligne=~/REGEXP/). Elle indique que $ligne doit contenir l'expression. Pour terminer on ferme le fichier.

#!/usr/bin/perl
open(FILEINPUT,"$ARGV[0]");
while ($ligne = <FILEINPUT>){
$ligne=~s/RECHERCHE/REMPLACEMENT/g;
print $ligne;
}
close(FILEINPUT);

On ouvre le fichier qui est le premier argument en ligne de commande et on l’associe au pointeur FILEINPUT. La boucle While indique que tant qu'il y a quelque chose à lire dans le fichier alors on va effectuer un remplacement avant d'afficher la ligne que l'on vient de lire. Pour terminer on ferme le fichier.

#/usr/bin/perl
#-----------------------------------------------------------
my $rep="$ARGV[0]";
# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
# on initialise une variable contenant le flux de sortie
my $DUMPFULL1="";
#----------------------------------------
my $output1="SORTIE.xml";
if (!open (FILEOUT,">$output1")) { die "Pb a l'ouverture du fichier $output1"};
#----------------------------------------
&parcoursarborescencefichiers($rep); #recurse!
#----------------------------------------
print FILEOUT "<?xml version=\"1.0\" encoding=\"iso-8859-1\" ?>\n";
print FILEOUT "<PARCOURS>\n";
print FILEOUT "<NOM>Votre nom</NOM>\n";
print FILEOUT "<FILTRAGE>".$DUMPFULL1."</FILTRAGE>\n";
print FILEOUT "</PARCOURS>\n";
close(FILEOUT);
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) {
# TRAITEMENT à réaliser sur chaque fichier
# Insérer ici votre code (le filtreur)
print $i++,"\n";
}
}
}
#----------------------------------------------

On distingue plusieurs étapes dans ce programme.

Dans la première partie du script, on s'assure que le nom du dossier ne se termine pas par un '/' ce qui perturberait le nom des chemins. Si jamais ça se termine par '/', on le remplace par rien. On évite ainsi un problème si quelqu'un tape : perl parcours.pl 2008/. Puis, on crée la variable : $DUMPFULL1 que l'on initialise à vide. $DUMPFULL1 va contenir les chaines de caractères qui vont être extraites.

Dans la seconde partie du script, on crée une sortie qui va contenir le résultat du parcours de l'arborescence.
La troisième partie contient uniquement un appel de sous programme. On fait cela grace au '&' qui permet d'appeler un sous programme qui a le même nom.

La quatrième partie contient la mise en forme de la sortie. On précise que la sortie sera au format XML. On remarque qu'il y a quelques balises dont la balise <FILTRAGE> .. </FILTRAGE> qui va contenir $DUMPFULL1. Dans cette étape, on ferme aussi le fichier en sortie avec la ligne : close(FILEOUT);.

Enfin, on entre dans le sous programme appelé plus haut. sub définit un sous programme.
Le sous programme prend un paramètre en argument. Il faut donc récupérer cet argument.@_ est une variable qui permet de stocker l'ensemble des arguments d'un sous programme. On peut y stocker un nombre quelconque de paramètres. Au début, cette variable contient $rep. shift est une fonction qui prend un tableau de scalaires en argument. Son rôle est d'enlever le premier élément du tableau et de revoyer sa valeur. Ainsi, on récupère en premier lieu 2008 que l'on met dans la variable $path.
La ligne : opendir(DIR, $path) or die "can't open $path: $!\n"; permet d'ouvrir un répertoire avec opendir ou d'arrêter le programme si l'ouverture n'est pas possible avec die. Si jamais l'ouverture n'est pas possible, un message d'erreur apparait. Puis, on lit le contenu du répetoire que l'on stocke sous forme de liste dans @files. Pour chaque élément de @files, on crée une variable $files. Si cette variable contient '..' on passe au suivant car un tel nom entrainerait une boucle infinie. Si le fichier a un nom correct, on ajoute ce nom au reste du chemin. On utilise le point comme opérateur de concaténation.
On effectue enfin un test pour voir si l'élément est un répertoire ou un dossier. S'il s'agit d'un dossier (-d), on relance le parcours de l'arborescence à l'intérieur du dossier en question. Cepedant, si l'élément est un fichier (-f), on réalisera un traitement.

#!/usr/bin/perl
open(FILEIN,"$ARGV[0]"); # on ouvre le fichier qu'on va lire
open(FILEOUT, ">resultatsMODIF.txt"); # on ouvre le fichier sur lequel on va écrire
$i=1; # compteur
while ($ligne = <FILEIN>){ # tant qu'il y a qqch à lire, on rentre dans la boucle
if ($ligne=~/<description>([^>]+)<\/description>/){ # si on trouve ce motif, on entre dans la boucle
my $propre=$1;# on prend le motif et on le met dans $propre
$propre=~s/&#38;#39;/\'/g;# nettoie
$propre=~s/&#38;#34;/\"/g;# nettoie
$propre=~s/&#233;/é/g;# nettoie
$propre=~s/&#234;/ê/g;# nettoie
print FILEOUT "contenu de la ligne n°$i : $propre\n"; # on affiche dans le fichier de sortie le motif trouvé et on les numérote avec le compteur
$i++; # on incrémente le compteur
} # fin de if
} # fin de while
close(FILEIN); # on ferme le fichier en lecture
close(FILEOUT);# on ferme le fichier en sortie

Ce programme est la version modifiée des programmes : script filtreur et script nettoyeur. Il a quelques fonctionnalités en plus. On ouvre un fichier qui va contenir la sortie : resultatsMODIF.txt et on ne garde que les lignes qui contiennent le motif : /<description>([^>]+)<\/description>, c'est à dire toutes les zones de texte comprises entre deux balises <description>. On remarque que dans l'expression régulière le '/' est despécialisé.
En plus, ce programme nettoie le fichier en entrée en remplaçant les entités HTML par les carcatères correpondants. Après le nettoyage, on constate qu'il y a un 'g'. L'option 'g' permet de gérer toutes les occurrences.
Le compteur est incrémenté à chaque fois que l'on sort de la boucle if et permet de numéroter les lignes en sortie.

#/usr/bin/perl
#-----------------------------------------------------------
my $rep="$ARGV[0]";
# on s'assure que le nom du répertoire ne se termine pas par un "/" si ça se termine par / on remplace par rien
$rep=~ s/[\/]$//;
# on initialise une variable contenant le flux de sortie
my $DUMPFULL1="";
my %tableaudestextes=(); # pour mémoriser ce qu'on a déjà imprimé, pour éviter les doublons
#----------------------------------------
my $output1="SORTIE.xml";
if (!open (FILEOUT,">$output1")) { die "Pb a l'ouverture du fichier $output1"};
#----------------------------------------
&parcoursarborescencefichiers($rep); # on appelle le sous programme
#----------------------------------------
print FILEOUT ".$DUMPFULL1.";
close(FILEOUT);
exit;
#----------------------------------------------
sub parcoursarborescencefichiers { # on entre dans le sous programme
my $path = shift(@_); # on met dans la variable $path le contenu de la variable mise en argument
opendir(DIR, $path) or die "can't open $path: $!\n"; # opendir : ouvre un rep - si on arrive pas : le pgm s'arrete et on envoie un message d'erreur
my @files = readdir(DIR); # on lit le contenu du répertoire et on renvoie une liste qu'on stocke dans @files
closedir(DIR);
foreach my $file (@files) { # pour chaque ressource dans @files,on crée $files
next if $file =~ /^\.\.?$/; # on passe au suivant si on trouve . ou .. car on risque une boicle infinie
$file = $path."/".$file; # on réécrit tout le chemin du fichier - le point permet la concaténation
if (-d $file) { # on entre dans cette boucle si il y a dans $file un répertoire (-d vérifie que l'argument est un répertoire)
&parcoursarborescencefichiers($file); #recurse!
}
if (-f $file) { # on entre dans cette boucle si il y a dans $file un fichier (-f vérifie que l'argument est un fichier)
if ($file=~/0,2-3208,1-0,0\.xml/){ # parcourt toute l'arborescence pour ne garder que les fichiers .xml
open(FILEIN,$file); # on ouvre le fichier qu'on va lire
$i=1; # compteur
print "$file\n"; # on voit si ça travaille
while ($ligne = <FILEIN>){ # tant qu'il y a qqch à lire, on rentre dans la boucle
if (($ligne!~/Retrouvez *l.*ensemble *des/) && ($ligne!~/Lisez *l.*int.*gralit.* *de *l.*article *pour *plus *d.*information./) && ($ligne!~/Toute *l.*actualit.* *au *moment *de *la *connexion/)) {
if ($ligne=~/<description>([^<]+)<\/description>/) { # si on trouve ce motif, on entre dans la boucle
my $propre=$1;# on prend le motif et on le met dans $propre
if ($propre=~/^(.+)&lt;img width='1' height='1'.*$/) {$propre=$1}; #permet de supprimer les balises images contenues dans description
$propre=~s/&#38;#39;/\'/g;# nettoie
$propre=~s/&#38;#34;/\"/g;# nettoie
$propre=~s/&#233;/é/g;# nettoie
$propre=~s/&#234;/ê/g;# nettoie
$propre=~s/&amp;eacute;/é/g;# nettoie
$propre=~s/&amp;egrave;/è/g;# nettoie
$propre=~s/&amp;icirc;/\î/g;# nettoie
$propre=~s/&amp;ocirc;/\ô/g;# nettoie
$propre=~s/&amp;ccedil;/\ç/g;# nettoie
$propre=~s/&amp;agrave;/\à/g;# nettoie
$propre=~s/&#38;/&/g;# nettoie
$propre=~s/&lt;/\ $propre=~s/&gt;/\ if (exists($tableaudestextes{$propre})) { # on mémorise $propre
$tableaudestextes{$propre}++; # on incrémente la valeur de $propre FACULTATIF (pour faire plaisir à M. FLEURY)
} # mais on ne la réimprime pas afin de supprimer les doublons si il existe déjà
else { # on entre dans cette boucle si il n'existe pas encore
$DUMPFULL1.="$propre\n"; # on concatène le contenu de $propre obtenu dans chaque boucle
$i++; # on incrémente le compteur
$tableaudestextes{$propre}++; # on incrémente pour dire qu'on a déjà rencontré ce texte pour qu'après si on le retrouve on ne réimprime pas la même séquence
}
} # fin de if
} # fin de if
} # fin de while
close(FILEIN); # on ferme le fichier en lecture
}
}
}
}
#----------------------------------------------

Par rapport à la version initiale du parcours de l'arborescence, ce script est beaucoup plus complet. On constate, comme on l'a annoncé prédemment qu'il contient les scripts nettoyeur et filtreur. On remarque, de plus, que des lignes supplémentaires ont été ajoutées dans le nettoyage car nous nous sommes rendu compte, en lançant le programme sur toute l'arborescence (au début nous ne travaillions que sur une sous partie du corpus pour faire les essais), qu'il y avait d'autres problèmes de codage à régler.

La ligne : if ($file=~/0,2-3208,1-0,0\.xml/) nous permet de ne récupérer que les fichiers qui concernent la rubrique A la Une . Si nous avions inscrit uniquement : if ($file=~/.xml/) nous aurions récupéré tous les fichiers qui ont une extension .xml.

Ce programme permet également d'éliminer les doublons présents dans les flux RSS. Pour cela, on crée un tableau : my %tableaudestextes=(); que l'on initialise à vide. Ce tableau va contenir les lignes que l'on imprime. La boucle : if (exists($tableaudestextes{$propre})) empêche les lignes déjà écrites d'être à nouveau écrites. Au contraire, la boucle else permet d'écrire les lignes qui n'ont pas encore été écrites. Ces lignes sont à leur tour stockées dans le tableau afin que d'éventuels doublons ne soient pas réécrits.

La ligne : if (($ligne!~/Retrouvez *l.*ensemble *des/) && ($ligne!~/Lisez *l.*int.*gralit.* *de *l.*article *pour *plus *d.*information./) && ($ligne!~/Toute *l.*actualit.* *au *moment *de *la *connexion/)) permet de filtrer les lignes que l'on récupère et de ne pas garder les lignes suivantes :
- Retrouvez l'ensemble des dépêches sur http://www.lemonde.fr
- Toute l'actualité au moment de la connexion
- Lisez l'intégralité de l'article pour plus d'information.
Il est important de mettre des && entre les phrases que l'on souhaite éliminer et non des ||. Les * sont situées au niveau des lettres accentuées et des espaces car les lettres accentuées peuvent être mal codés et les espaces multiples. Avec ces précautions, on prend en compte tous les cas de figures possibles.

Cette ligne : if ($propre=~/^(.+)&lt;img width='1' height='1'.*$/) {$propre=$1}; permet de supprimer les balises images qui venaient polluer la sortie.

Enfin, on remarque que ce fichier génère une sortie au format xml : my $output1="SORTIE.xml";. C'est le format dont nous aurons besoin par la suite pour travailler avec Treetagger. Au contraire, Cordial nécessite une sortie au format texte, il faudra donc remplacer my $output1="SORTIE.xml"; par my $output1="SORTIE.txt"; pour obtenir une sortie au bon format.