﻿#!/usr/bin/perl

<<DOC; 
Charlène Denis et Larisa Nadel
JUIN 2012
Usage : perl programme_parcours.pl repertoire-a-parcourir

Le programme prend en entrée le nom du répertoire contenant des flux RSS à traiter
Le programme parcourt les ce répertoire et répere la rubrique indiquée dans chaque fichier
En sortie, le programme crée un répertoire RESULTATS contenant un sous-répertoire pour chaque rubrique trouvée
Dans chaque sous-répertoire trois fichiers sont construits : 
	- un fichier .txt avec les données textuelles extraites des fils RSS (titres des articles et leur contenu)
	- un fichier .xml contenant la même information que celui de .txt mais organisée par des balises xml 
	- un fichier .ttg.xml contenant les données extraits et etiquetées par le programme Treetagger
Cette variante du programme utilise le module des expressions regilières pour récupérer le contenu textuel
DOC

#-----------------------------------------------------------------------

#On va utiliser la bibliothèque Unicode::String
use Unicode::String qw(utf8);

#-------------------------CHOIX DU RÉPERTOIRE---------------------------

#On récupère le chemin vers le répertoire donnée par l'utilisateur
my $rep="$ARGV[0]";	
$rep=~ s/[\/]$//;	

#-------------------------DEFINITION DES VARIABLES-----------------------
	
my %titleDic=();	
my %descrDic=();
my %dictionnairedesrubriques=();

my $i=1;
my $encodagexml="utf-8";
my $encodagetxt="iso-8859-1";

#------------------------------------------------------------------------

#On crée le répertoire de sortie
mkdir("RESULTATS");

#On lance la fonction du parcours récursif de l'arbre des fils
&parcoursarborescencefichiers($rep);

#En résultat du parcours, on obtient une nouvelle arborescence des fichiers, cette fois celle des fichiers de sortie organisés par rubrique
#Maintenant il faut ajouter des balises fermantes aux fichiers en format xml
#Il n'était pas possible de le faire dans la fonction "parcoursarborescencefichiers" parce que la boucle principale parcourt les fichiers d'entrée et pas ceux de sortie !

#Pour chaque rubrique du tableau associatif qui a été construite par la fonction...
my @liste=keys(%dictionnairedesrubriques);
foreach my $rub(@liste) {

	#On repère ses fichiers de sortie en format xml
	my $output1="RESULTATS/$rub/sort$rub.xml";
	my $output3="RESULTATS/$rub/sort$rub.ttg.xml";

	#Et on y met les balises fermantes
	open (FILEOUT_XML,">>:encoding($encodagexml)",$output1) or die "pb ouverture fichier $!";
	print FILEOUT_XML "</FILTRAGE>\n</PARCOURS>";
	open (FILEOUT_TTG,">>:encoding($encodagexml)",$output3) or die "pb ouverture fichier $!";
	print FILEOUT_TTG "</ETIQUETAGE>\n</PARCOURS>";}
exit;	#on sort

#------------------------PARCOURS DES FILS RSS--------------------------

#Le parcours des fichiers est le même que celui de BaO1
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);	
	}
		if (-f $file) {	
			if ($file=~/\.xml$/) {	
			#Le nom du fichier ne doit pas contenir de lettres (sinon on traite des fichiers dont la structure n'est pas standard, on ne récupère pas la rubrique et on tombe dans l'erreur !) 
			if ($file !~ /fil/) {


#------------------------TRAITEMENT DU FILTRAGE--------------------------
			
				my $encodage=`file -i $file | cut -d= -f2`;
				chomp($encodage); 
				print $i++,"\n";
				print "ENCODAGE: $encodage \n";
				
				#On ouvre le fichier en mode lecture grâce au <:	
				open (FILEIN, "<",$file);
				my $texte="";

				#Et on le lit ligne par ligne
				while (my $ligne=<FILEIN>){

					chomp($ligne);

					#Par une expression régulière, on supprime les espaces entre les balises 	
					$ligne=~ s/> *?</></g;

					#On concatène toutes les lignes dans la variable $texte 
					$texte.=$ligne;
				}
				#Une autre expression regulière nous permet de recuperer les lignes contenant la rubrique et les données de publication				
				$texte=~/<channel>.+?<title>(.+?)<\/title>.+?<pubDate>(.+?)<\/pubDate>/;
				my $rub=$1;
				my $donnees=$2;
				
				#Le texte extrait est converti en utf-8 si nécessaire 
				if (uc($encodage) ne "UTF8") {utf8($rub); utf8($donnees)};

				#Par une série d'expressions régulières, on extrait le nom de la rubrique de sa ligne et on le formate afin qu'il puisse servir de nom de répertoire
				$rub=~s/é/e/gi;
				$rub=~s/è/e/gi;
				$rub=~s/ê/e/gi;
				$rub=~s/à/a/gi;
				$rub=~ s/( - )?Le *?Monde *\. *?fr *:? *//gi;
				$rub=~ s/ /_/g;
				$rub=~ s/,//;
				$rub=uc($rub);
				print "$rub\n";

#-------------------------------TEST DE RUBRIQUE--------------------------------------------------------------

				#Dans la version initiale du programme, on faisait deux parcours : l'un pour repérer les rubriques et l'autre pour effectuer le filtrage et l'étiquettage des fils RSS
				#Dans notre variante, on ne fait qu'un seul parcours
				#Pour cela, la solution de vérification des doublons utilisée dans la BàO1 est appliquée

				#Si la rubrique est nouvelle...
				if (!(exists($dictionnairedesrubriques{$rub}))) {

					#On l'ajoute au tableau associatif des rubriques
					$dictionnairedesrubriques{$rub}++;

					#On crée un sous-répertoire correspondant dans le répertoire de sortie
					mkdir ("RESULTATS/$rub");

					#Dans cet sous-répertoire on va créer trois fichiers pour la sortie
					my $output1="RESULTATS/$rub/sort$rub.xml";
					my $output2="RESULTATS/$rub/sort$rub.txt";
					my $output3="RESULTATS/$rub/sort$rub.ttg.xml";
					open (FILEOUT_XML,">:encoding($encodagexml)",$output1) or die "pb ouverture fichier $!";
					open (FILEOUT_TXT,">:encoding($encodagetxt)",$output2) or die "pb ouverture fichier $!";
					open (FILEOUT_TTG,">:encoding($encodagexml)",$output3) or die "pb ouverture fichier $!";

					#Dans les fichiers en format xml on écrit la préambule et les premières balises ouvrantes	
					print FILEOUT_XML "<?xml version=\"1.0\" encoding=\"$encodagexml\" ?>\n";
					print FILEOUT_XML "<PARCOURS>\n<NOM>Denis, Ivanova, Nadel</NOM>\n<FILTRAGE>\n";

					print FILEOUT_TTG "<?xml version=\"1.0\" encoding=\"$encodagexml\" ?>\n";
					print FILEOUT_TTG "<PARCOURS>\n<NOM>Denis, Ivanova, Nadel</NOM>\n<ETIQUETAGE>\n"; 
					}

				#Si la rubrique n'est pas nouvelle,
                                else {
					#On incrémente sa valeur dans le tableau des rubriques (c'est la même opération que celle d'ajouter)
					$dictionnairedesrubriques{$rub}++;

					#On ouvre les trois fichiers déjà existants
					# ">>" permet d'ajouter de l'information au fichier au lieu de le réécrire
                                        my $output1="RESULTATS/$rub/sort$rub.xml";
					my $output2="RESULTATS/$rub/sort$rub.txt";
					my $output3="RESULTATS/$rub/sort$rub.ttg.xml";
					open (FILEOUT_XML,">>:encoding($encodagexml)",$output1) or die "pb ouverture fichier $!";
					open (FILEOUT_TXT,">>:encoding($encodagetxt)",$output2) or die "pb ouverture fichier $!";
					open (FILEOUT_TTG,">>:encoding($encodagexml)",$output3) or die "pb ouverture fichier $!";	
					}

#A ce niveau, on est sûr que quelle que soit la rubrique du fichier en cours de traitement, il existe pour elle un dossier avec trois fichiers ouverts pour y enregistrer le résultat de filtrage et de l'étiquetage 

#----------------------------------FILTRAGE ET ETIQUETAGE-------------------------------------------

				#On continue à préparer la sortie : dans les variables qui seront plus tard envoyées aux fichiers xml, on stocke le numéro du fichier portant la rubrique en cours et les données de pubication
				my $DUMPFULL_XML="<FILE numero=\"$dictionnairedesrubriques{$rub}\"><DATE>$donnees<\/DATE><ARTICLES>";		
				my $DUMPFULL_TTG="<FILE numero=\"$dictionnairedesrubriques{$rub}\"><DATE>$donnees<\/DATE><ARTICLES>";
				my $DUMPFULL_TXT="";

				#Une variable pour compter les articles
				my $n_article=0;
			
				#Grâce à l'expression regulière qu'on a déjà vu dans la BàO1, on extrait le titre et le contenu de chaque article
				while ($texte=~/<item>.+?<title>(.+?)<\/title>.+?<description>(.+?)<\/description>/g) {
					my $titre=$1;
					my $description=$2;

					#On les transforme, si nécessaire, en utf-8 et on les nettoie
					if (uc($encodage) ne "UTF8") {utf8($titre);utf8($description);};
					$titre=&nettoietexte($titre);
					$description=&nettoietexte($description);

					#On incrémente le compteur et on enregistre la balise de l'article dans les variables de sortie
					$n_article++;							
					$DUMPFULL_XML.="<article numero=\"$n_article\">\n";
					$DUMPFULL_TTG.="<article numero=\"$n_article\">\n";

#----------------------------------------VERIFICATION DES DOUBLONS-------------------------------------------------------------

					#Le procédure de vérification des doublons est un peu modifiée par rapport à celle de la BàO1
					#Ici, on procède au traitement du contenu de l'article seulement si le titre est "original"
					
					#Si le titre existait avant...
					if (!(exists($titleDic{$titre}))) {

						#On l'étiquette grâce à une fonction définie en bas
						my $titreetiq=&etiqttg($titre);

						#Et on enregistre le résultat dans les trois variables de sortie
						$DUMPFULL_TXT.="Titre : ".$titre." \n";
				    		$DUMPFULL_XML.="<abstract>$titre</abstract>\n";
						$DUMPFULL_TTG.="<abstract>$titreetiq</abstract>\n";

				    		$titleDic{$titre}++;

							#On fait le même test sur le contenu
							if (!(exists($descDic{$description}))) {
							my $descretiq=&etiqttg($description);
							$DUMPFULL_TXT.="Description : ".$description." \n";
			    				$DUMPFULL_XML.="<description>$description</description>\n";
							$DUMPFULL_TTG.="<description>$descretiq</description>\n";
							$descDic{$description}++;}
						else {
							#Si le contenu n'est pas original, on ne garde que le vide
				    			$descrDic{$description}++;
				    			$DUMPFULL_XML.="<description>-</description>\n";
							$DUMPFULL_TXT.="Description : - \n";
				    			$DUMPFULL_TTG.="<description>-</description>\n";}
						}

					else {
						#Pareil pour le titre : si on l'a déjà vu dans un autre fichier, on ne le garde pas
				   		$titleDic{$titre}++;
				    		$DUMPFULL_XML.="<abstract>-</abstract>\n";
						$DUMPFULL_TTG.="<abstract>-</abstract>\n";
						}
				
					#On met les balises fermantes pour l'élément article
					$DUMPFULL_XML.="</article>\n";
					$DUMPFULL_TTG.="</article>\n";
 
				} #Ferme while

			#A la fin du parcours du chaque fichier, on met les balises de fermeture
			$DUMPFULL_XML.="</ARTICLES></FILE>";
			$DUMPFULL_TTG.="</ARTICLES></FILE>";
			print FILEOUT_TXT $DUMPFULL_TXT;
			print FILEOUT_XML $DUMPFULL_XML;
			print FILEOUT_TTG $DUMPFULL_TTG;		
			} #Ferme if
		
			close (FILEIN);
		
		} #Ferme if
		}
	
	} #Ferme foreach file
	
}

#---------------------FONCTION DE NETTOYAGE-----------------------------

#Initialisation d'une fonction fournie pour le nettoyage du texte

sub nettoietexte {
    my $texte=shift;
    $texte =~ s/&lt;/</g;
    $texte =~ s/&gt;/>/g;
    $texte =~ s/<a href[^>]+>//g;
    $texte =~ s/<img[^>]+>//g;
    $texte =~ s/<\/a>//g;
    $texte =~ s/&#38;#39;/'/g;
    $texte =~ s/&#38;#34;/"/g;
    $texte =~ s/&#233;/é/g;
    $texte =~ s/&#234;/ê/g;
    $texte =~ s/<[^>]+>//g;
    $texte =~ s/&nbsp;/ /g;
    $texte=~s/&#39;/'/g;
    $texte=~s/&#34;/"/g;
    $texte=~s/&amp;#39;/'/g;
    $texte=~s/&amp;#34;/"/g;
    return $texte;
}

#-----------------------FONCTION D'ETIQUETTAGE----------------------------------

#Pour étiqueter nos données, on va lancer le programme de Treetagger
#Le dernier prend en entrée un fichier en format texte brut avec un mot sur chaque ligne
#Il founrit en sortie un fichier aussi en format texte, avec trois colonnes : token, catégorie, lemme

sub etiqttg {
	
	#On récupère l'argument passé à la fonction (soit le texte extrait)
	my ($texte)=@_;

	my $texteetiq="";

	#On ouvre un fichier temporaire pour formater l'entrée de Treetagger
	my $tmptag="texteaetiqueter.txt";
	open (TMPFILE,">:encoding(utf-8)", $tmptag);

	#On y stocke notre texte à étiquetter
	print TMPFILE $texte,"\n";
	close(TMPFILE);

	#On lance une petite cascade de programmes dans laquelle le 1er prend en entrée notre fichier temporaire, le divise en mots et enregistre un mot par ligne. On renvoie la sortie de ce programme à Treetagger
	#Ce dernier prend comme argument un fichier de parametre de codage (french-par-linux-3.2-utf8.bin) et enregistre le texte etiqueté dans un fichier treetagger.txt 

	system("perl tokenise-utf8.pl $tmptag | ./tree-tagger french-par-linux-3.2-utf8.bin -lemma -token -no-unknown -sgml > treetagger.txt");

	#Encore un programme, treetagger2xml-utf8.pl, convertit la sortie de Treetagger en xml en créant un nouveau fichier treetagger.txt.xml
	system("perl ./treetagger2xml-utf8.pl treetagger.txt $encodagexml");

	#Et il ne reste qu'à lire ce fichier ligne par ligne
	open(OUT,"<:encoding(utf-8)","treetagger.txt.xml");

	#La première ligne du fichier n'est pas prise en compte, c'est la préambule xml
	my $fistline=<OUT>;
	my $titreetiquete="";
	while (my $l=<OUT>) {
	$texteetiq.=$l;
	}
	close(OUT);
	
	#Enfin, la fonction rend le texte étiqueté
	return ($texteetiq);
}
