#!/usr/bin/perl
# on met un ! apres le # pour indiquer qu'il ne s'agit pas d'un commentaire
# indique qu'il s'agit d'un script perl

##########################################################################
<<DOC; # Spécifique a perl. Ce bloc permet de generer de la documentation 
PROJET ENCADRE II JUIN 2012
Boite a outil 1 : Extraction de donnees textuelles
Marine Delaborde & Katell Toulgoat

Usage : perl bao1_methode2.pl repertoire-a-parcourir

Le programme prend en entrée le nom du répertoire contenant les fichiers de fils RSS à traiter et donne en sortie deux fichiers (TXT et XML).

Solution pour trouver les balises <title> et <description> avec la bibliothèque XML::RSS.

DOC
##########################################################################

#-----------------------------------------------------------
# BIBLIOTHEQUES
#-----------------------------------------------------------

use Unicode::String qw(utf8); 
# Bibliotheque permettant de convertir les données en utf-8

use XML::RSS;
# Bibliotheque specifique a perl permettant de trouver les balises souhaitees dans les fichiers XML des fils RSS

#-----------------------------------------------------------
# ENCODAGE DE SORTIE
#-----------------------------------------------------------

my $encodagesortie="utf-8"; 
# On prevoit une variable contenant l'encodage de sortie

#-----------------------------------------------------------
# REPERTOIRE
#-----------------------------------------------------------

my $repertoire="$ARGV[0]";
# On veut recuperer la premiere valeur de la ligne de commande. Pour cela, on utilise $ARGV[0]. Il contiendra le nom du repertoire (ou le chemin qui y mene).

$repertoire=~ s/[\/]$//;
# On s'assure que le nom du répertoire ne se termine pas par un "/" à l'aide d'une expression reguliere. On cherche donc un "/" qui se trouve en fin de ligne dans la variable $repertoire. Si on le trouve, on utilise une formule de substitution pour le remplacer par rien (=suppression). Il faut faire attention a bien despecialiser le "/" car c'est aussi un delimiteur dans la formule de substitution.


#-----------------------------------------------------------
# TABLE HACHAGE
#-----------------------------------------------------------

my %dico_articles=();
# On initialise une table de hachage (dictionnaire) pour ne pas reccueillir de doublons lors de la récuperation des fils rss 


#-----------------------------------------------------------
# SORTIES
#-----------------------------------------------------------

# XML :
my $TEXTE1=""; # On initialise le contenu textuel que l'on placera dans le fichier de sortie
my $fichier_sortie1="Sortie-BAO1-Methode2.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-Methode2.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
#-----------------------------------------------------------

&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"; # Nom du fichier XML
print SORTIE1 "<FILTRAGE>".$TEXTE1."</FILTRAGE>\n"; # Contenus textuels
print SORTIE1 "</PARCOURS>\n"; # On ferme la balise
close(SORTIE1); # On ferme le fichier

# TXT : 
print SORTIE2 $TEXTE2; # On ecrit le texte extrait dans le fichier texte
close (SORTIE2); # On ferme le fichier
exit;


#-----------------------------------------------------------
# FONCTION D'EXTRACTION DE TEXTE DANS LES FICHIERS
#-----------------------------------------------------------

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 "Problème à l'ouverture de $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 de les placer 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
	 			
				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

						#-----------------------------------------------------------
						# 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\">\n<TITRE>".$titre."</TITRE>\n <DESCRIPTION>".$description."</DESCRIPTION>\n</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
  			  }
		}			
	}	
}


#-----------------------------------------------------------
# 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;

}
