Boîte à outils n°1

Notre objectif pour cette première boîte à outils est de parcourir une arborescence de fils rss et d'en extraire des contenus textuels à l'aide de scripts perl.

Programme

La devise de Perl est "TIMTOWTDI" ("There Is More Than One Way To Do It") dans la mesure où il existe plusieurs manières d'effectuer un même traitement avec ce langage de programmation. Linguistiquement, cela se rapproche de la synonymie, ou de la périphrase. Nous allons concrétiser ce slogan dans cette première boîte à outils. Parmis les différentes méthodes pour extraire des données textuelles, en voici deux : une à l'aide d'expressions régulières, et une avec la bibliothèque XML::RSS.

Nous sommes donc parties de scripts de départ vus en cours que nous nous sommes appropriés et que nous avons modifés pour gérer :

L'hétérogénéïté des encodages des fils RSS :

# Avant d'ouvrir le fichier :

my $encodage=`file -i $fichier| cut -d= -f2`;
# On recupere l'encodage du fichier de depart avec la commande file -i

chomp($encodage);
# Et si le dernier caractere de la ligne est un saut de ligne, on le supprime grace a la commande chomp





# Dans le traitement du contenu du fichier : 

if (uc($encodage) ne "UTF-8") {utf8($titre);utf8($description);}
# Si l'encodage n'est pas de l'utf-8, on met le titre et la description en utf-8

Et du coup, les scories d'encodage :

#-----------------------------------------------------------
# NETTOYAGE DU TEXTE (fonction)
#-----------------------------------------------------------

# On gere les soucis d'encodage par des formules de substitution :
sub nettoietexte {
	my $texte = shift(@_);
	$texte =~ s/> *</></g; # le g permet de remplacer toute la chaine de caractere et non pas un caractère a la fois
	$texte =~ s/&lt;/</g;
	$texte =~ s/&gt;/>/g;
	$texte =~ s/<a href[^>]+>//g;
	$texte =~ s/<img[^>]+>//g;
	$texte =~ s/<\/a>//g;
	$texte =~ s/<[^>]+>//g;
	$texte =~ s/&#233;/é/g;
	$texte =~ s/&#234;/ê/g;
	$texte =~ s/&#38;39;/'/g;
	$texte =~ s/&#38;34;/"/g;
	$texte =~ s/&amp;#39;/'/g;
	$texte =~ s/&amp;#34;/"/g;
	$texte =~ s/&nbsp;/ /g;

	return $texte;

}

Cette fonction de nettoyage du texte est appelée au sein de la fonction de parcours de l'arborescence des fichiers par les lignes suivantes :

$titre = &nettoietexte($titre);
# On lance la procedure de nettoyage sur le titre

$description = &nettoietexte($description);
# On lance la procedure de nettoyage sur la description

Les fichiers xml sur une ligne ou plusieurs :

while (my $ligne = <FICHIER>){
# On parcours les lignes de ce fichier

chomp($ligne);
# Si le dernier caractere de la ligne est un saut de ligne, on le supprime grace a la commande chomp

$texte.=$ligne;
# On ajoute chaque ligne a la variable "texte" pour tout avoir sur une seule ligne.
				}

La bonne formation des fichiers XML produits :

Bonne formation de la sortie XML de la solution 1

Bonne formation de la sortie XML de la solution 2

Voilà le programme principal :

#-----------------------------------------------------------
# PREPARATION DES SORTIES
#-----------------------------------------------------------

# XML :
my $TEXTE1=""; # On initialise le contenu textuel que l'on placera dans le fichier de sortie
my $fichier_sortie1="Sortie-BAO1-Methode1.xml"; # Fichier de sortie
open(SORTIE1,">:encoding($encodagesortie)",$fichier_sortie1); # On encode la sortie avec l'encodage définit plus tôt

# TXT :
my $TEXTE2=""; # On initialise le contenu textuel que l'on placera dans le fichier de sortie
my $fichier_sortie2="Sortie-BAO1-Methode1.txt"; # Fichier de sortie
open(SORTIE2,">:encoding($encodagesortie)",$fichier_sortie2); # On encode la sortie avec l'encodage définit plus tôt


#-----------------------------------------------------------
# APPEL DE FONCTION DE PARCOURS DE L'ARBORESCENCE
#-----------------------------------------------------------

&parcoursarborescencefichiers($repertoire); # Elle est récursive
# On appelle une fonction (c'est pas imperatif de mettre le & mais c'est tres utile pour savoir que l'on appelle une procedure/fonction). Cette procedure possede un argument : la variable qui contient le repertoire. Il faut que cette procedure la soit definie quelque part dans le programme. Cette procedure effectue le parcours de l'arborescence des fichier pour pouvoir ensuite en extraire le contenu textuel.

#-----------------------------------------------------------
# ECRITURE DANS LES FICHIERS DE SORTIE
#-----------------------------------------------------------

# XML :
print SORTIE1 "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print SORTIE1 "<PARCOURS>\n"; # on ouvre la balise
print SORTIE1 "<NOM>".$fichier_sortie1."</NOM>\n";
print SORTIE1 "<FILTRAGE>".$TEXTE1."</FILTRAGE>\n";
print SORTIE1 "</PARCOURS>\n"; # on ferme la balise
close(SORTIE1); # on ferme le fichier

# TXT : 
print SORTIE2 $TEXTE2;
close (SORTIE2);
exit;

Ce programme consiste à créer des fichiers de sortie et à initialiser des variables qui contiendront le contenu à placer dans ces fichiers après le traitement effectué par la fonction. La fonction en question consiste à parcourir l'arborescence des fichiers pour en extraire du contenu textuel. Nous présenterons cette fonction dans la Solution 1, puis nous présenterons les parties qui en diffèrent dans la Solution 2.

C'est à l'intérieur de cette fonction que nous décidons de choisir la rubrique "A la Une" parmis les rubriques des fils RSS du Monde pour en extraire les données textuelles. Elle est intéressante car elle possède beaucoup d'articles. Nous avons récupéré le code correspondant à cette rubrique en parcourant manuellement l'arborescence des fichiers :

Et nous avons inséré ce code dans notre script pour définir la rubrique choisie :

if ($fichier =~ /0,2-3208,1-0,0\.xml$/) {

Les deux scripts suivants produisent le même résultat en sortie. La première solution consiste à "réinventer la roue" car on effectue avec l'expression régulière un traitement qui existe déjà et qui est disponible dans une bibliothèque Perl. Toutefois, il est intéressant de noter que le traitement de la solution 2 est légèrement plus long que celui de la première.

Solution 1 : méthode "rustique" (avec une expression régulière)

La fonction du parcours de l'arborescence :

sub parcoursarborescencefichiers { # On definit la fonction

    my $path = shift(@_);
    # shift travaille sur une liste (@_) qui donne en contexte la liste des arguments passes a parcoursarboresencefichiers (dans le contexte d'une fonction ou d'une procedure).C'est a dire la valeur de $repertoire. on lui affecte donc le nom du repertoire de l'argument : la racine de l'arborescence.

    opendir(DIR, $path) or die "Probleme à l'ouverture du repertoire $path: $!\n";
    # On ouvre la racine de l'arborescence des fils rss. Et si cette operation fonctionne, on arrete la et on passe a la suite. Mais si cette operation echoue, on execute ce qu'il y a apres, c'est a dire : arret du script et on affichage d'un message d'echec a l'utilisateur.

    my @fichiers = readdir(DIR);
    # readdir permet de lire tout le repertoire DIR ouvert a la ligne precedente et d'en placer le contenu dans une liste
    
    closedir(DIR);
    # On ferme le repertoire. A partir de la on ne peut plus utiliser le repertoire (mais on a enregistre son contenu dans une variable @fichiers alors c'est bon).


    foreach my $fichier (@fichiers) {
    # On effectue un traitement sur chacun des elements du repertoire DIR contenus dans @fichiers. Mais attention a la portee : a la sortie de cette boucle, $fichier ne sera plus connu!

		next if $fichier =~ /^\.\.?$/;
		# Si l'element contient un point...
		# Important : despecialiser le "." sinon il signifie "n'importe quel caractere".

		$fichier = $path."/".$fichier;
		# ... c'est un fichier. Donc on reecrit le chemin complet pour retrouver ce fichier, dans une variable.


		if (-d $fichier) {
		# On fait un test sur l'objet $fichier : si cet element est un repertoire (-d), on effectue le traitement suivant :
			&parcoursarborescencefichiers($fichier);
			# ... on reconstruit un path : on refais un tour de boucle pour obtenir les fichiers qu'il contient.
		} 

		if (-f $fichier) {
		# On cherche aussi a savoir si cet element est un fichier. Et si c'est le cas, on effectue le traitement suivant : 

			if ($fichier=~/0,2-3208,1-0,0\.xml$/) {
			# Et si c'est le fichier XML de la rubrique "A la une". Ils sont nommes avec le code "0,2-3208,1-0,0".

				$j++;
				# On incremente le compteur des numeros des fichiers

				$TEXTE1.="<FICHIER numero=\"$j\">";
				# On ouvre une balise pour chaque fichier dans la sortie XML avec son numero indique par le compteur de la ligne precedente

				my $encodage=`file -i $fichier| cut -d= -f2`;
				# Alors on recupere son encodage avec la commande file -i

				chomp($encodage);
				# Et si le dernier caractere de la ligne est un saut de ligne, on le supprime grace a la commande chomp

				print "Encodage du fichier  : $encodage \n";
				# Et on affiche cet encodage
				
				
				#-----------------------------------------------------------
				# FILTRAGE DU TEXTE	
				#-----------------------------------------------------------

				open(FICHIER,"<:encoding($encodage)", $fichier);
				# On ouvre le fichier en specifiant l'encodage trouve precedemment

				my $texte="";
				# On initialise la variable qui contiendra le texte

				while (my $ligne = <FICHIER>){
				# On parcours les lignes de ce fichier

					chomp($ligne);
					# Si le dernier caractere de la ligne est un saut de ligne, on le supprime grace a la commande chomp

					$texte.=$ligne;
					# On ajoute chaque ligne a la variable "texte" pour tout avoir sur une seule ligne.
				}

				close (FICHIER);
				# On ferme le fichier

				$i=0;
				# On initialise la variable qui contiendra les numeros des articles (compteur)

				while ($texte =~ /<item><title>(.+?)<\/title>.+?<description>(.+?)<\/description>/gi) {
				# EXPRESSION REGULIERE : pour rechercher les balises "title" et "description" dans le texte recupere precedemment
					
					my $titre = $1; 
					# On extrait le contenu de la balise "title"

					my $description=$2;
					# On extrait le contenu de la balise "description"

					if (uc($encodage) ne "UTF-8") {utf8($titre);utf8($description);}
					# Si l'encodage n'est pas de l'utf-8, on met le contenu en utf-8

                				$titre = &nettoietexte($titre);
						# On lance la procedure de nettoyage sur le titre

               				        $description = &nettoietexte($description);
						# On lance la procedure de nettoyage sur la description
               				        

						#-----------------------------------------------------------
						# ECRITURE DANS LES FICHIERS DE SORTIE
						#-----------------------------------------------------------				

                				if(!exists $dico_articles{$description}){
						# Si l'article n'est pas deja dans le dico (evite les doublons)
                				
							$i++;
							# On incremente le compteur des articles

							$TEXTE1 .= "<ARTICLE numero=\"$i\"><TITRE>$titre</TITRE><DESCRIPTION>$description</DESCRIPTION></ARTICLE>\n";
							# On extrait le titre et la description dans le fichier XML entre les bonnes balises en donnant un numero a l'article
 
                   					$TEXTE2 .="TITRE : ".$titre."\nDESCRIPTION : ".$description."\n\n";
							# On extrait le titre et la description dans le fichier texte

						
                    					$dico_articles{$description}=1;
							# On attribue a la clé de l'element 'description' la valeur 1
                    				 }
						else { print "DOUBLON\n" }
						# Mais si il est deja dans le tableau, c'est un doublon donc on n'ecrit rien dans les fichiers de sortie
					}
			$TEXTE1.="</FICHIER>";
			# On ferme la balise 'fichier' dans le fichier XML			
				}
			}
		}	
	}

Les expressions regulieres permettent de manipuler du texte de manière précise et puissante. Ici, nous nous en sommes servies pour rechercher un motif dans les fichiers XML des fils RSS. L'expression que nous avons utilisé permet de trouver toutes les occurrences de la forme recherchée grâce à l'utilisation de l'option "g". Et elle n'est pas sensible à la casse grâce à l'utilisation de la fonction "i" (en effet, les balises XML peuvent être écrites en minuscules ou en majuscules). On recherche après la balise <item>, les balises <title> et <description> (on a besoin de le préciser car ces balises existent aussi après la balise <channel>). On cherche ces balises ainsi que leur contenu (elles peuvent contenir un caractère quelconque 0 ou 1 fois).

Télécharger le script

Télécharger la sortie texte (utf-8)

Télécharger la sortie XML

Solution 2 : bibliothèque xml : : rss

Le script utilisé est le même que celui de la Solution 1. Seule varie la méthode de recherche des balises dans les fils RSS. Ici, nous avons utilisé la bibliothèque perl XML::RSS :

open(FICHIER,"<:encoding($encodage)", $fichier);
				# On ouvre le fichier en specifiant l'encodage trouve precedemment

				my $texte="";
				# On initialise la variable qui contiendra le texte
	 			
				my $rss = new XML::RSS;
				# On instancie un objet RSS

				eval {$rss->parsefile($fichier); }; 
				# On inclue le resultat du parseur dans la variable $rss
				
				$i=0;
				# On initialise la variable qui contiendra les numeros des articles (compteur)

	 			foreach my $item (@{$rss->{'items'}}) {
				# XML::RSS nous permet d'effectuer une recherche dans les items des fils RSS

	 					my $titre = $item->{'title'};
						# On recupere le contenu des balises 'title' lorsqu'on en rencontre

	 					$titre = &nettoietexte($titre);

						# On nettoie le titre a l'aide de la fonction de nettoyage

						$titre =~ s/&/et/g; 
						# Remplacement du '&' par 'et'

						$titre =~ s/<.+>//g; 
						# Remplacement des balises par rien (suppression)
					
						my $description = $item->{'description'};
						# On recupere le contenu des balises 'description' lorsqu'on en rencontre

						chomp($description);
						# On supprime le dernier caractere de la ligne si c'en est un

						$description = &nettoietexte($description);
						# On nettoie la description a l'aide de la fonction de nettoyage

						$description =~ s/&/et/g; 
						# Remplacement du '&' par 'et'

						$description =~ s/<.+>//g; 
						# Remplacement des balises par rien (suppression)
					
						if (uc($encodage) ne "UTF-8") {utf8($titre);utf8($description);}
						# Si l'encodage n'est pas de l'utf-8, on met le contenu en utf-8