﻿#!/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 etiquettées par le programme Treetagger
Cette variante du programme utilise la bibliothéque perl XML::RSS pour récupérer le contenu textuel
DOC
#-----------------------------------------------------------------------
#On va utiliser deux bibliothéques : XML::RSS pour traiter les fichiers d'entrée et Unicode::String pour les conversions d'encodage
use XML::RSS;
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";

my $TOTAL_TXT="";
open (TOTAL, ">>:encoding($encodagetxt)", "sorttotal.txt");

#------------------------------------------------------------------------
# On crée le répertoire de sortie
mkdir("RESULTATS");

# On lance la fonction du parcours recursif de l'arbre des fils
&parcoursarborescencefichiers($rep);

#En resultat du parcours, on obtient un nouveau arborescence des fichiers, cette fois celui de fichiers de sortie organisés par rubrique
#Maintenant il faut ajouter des balises fermantes aux fichiers en format xml
#Il é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) {
	my $output1="RESULTATS/$rub/sort$rub.xml";
	my $output3="RESULTATS/$rub/sort$rub.ttg.xml";
	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 pareil à 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$/) {

			#Après avoir testé le programme sur l'arborescence de LeMonde 2011, on a du ajouter encore deux conditions :

			#le nom du fichier ne doit pas contenir de lettres (sinon on traite des fichiers dont la structure n'est pas standarte!) 
			if ($file !~ /fil/) {

			#le fichier ne doit pas être vide (on teste seulement la 1re ligne, mais c'est suffisant)
			open (FILEIN, "<",$file);
			my $ligne=<FILEIN>;
			if (!($ligne=""))

#------------------------TRAITEMENT DU FILTRAGE--------------------------
			
			{
				print $i++,$file,"\n";
				my $encodage=`file -i $file | cut -d= -f2`; 
				chomp($encodage); 
				print "ENCODAGE: $encodage \n";
				
				#On crée un ouvel objet de la bibliothèque XML::RSS
				my $rss=new XML::RSS;

				#Dans la variable $rss, on enregistre les résultats du parsing du fil RSS
				$rss->parsefile($file);

				#On récupère le nom de la rubrique et les données de publication en définissant le chemin vers les noeuds correspondants
				my $rub=$rss->{'channel'}->{'title'};
				my $donnees=$rss->{'channel'}->{'pubDate'};

				#Le texte extrait est converti en utf-8 si c'est necessaire 
				if (uc($encodage) ne "UTF8") {utf8($rub); utf8($donnees);}

				#Par une série des expressions regulières, on extrait le nom de la rubrique de sa ligne et on le formate afin qu'il puisse servir de nom d'un 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 originale du programme, on faisait deux parcours : l'un pour repèrer les rubriques et l'autre 						pour effectuer le filtrage et l'etiquettage des fils RSS
				#Dans notre variante, on ne fais qu'un seul parcours
				#Pour cela, la solution de vérification des doublons utilisée dans la BaO1 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 correspondants dans le repertoire 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 incremente sa valeur dans le tableau des rubriques (c'est la même operation que celle d'ajouter)
					$dictionnairedesrubriques{$rub}++;
                                        my $output1="RESULTATS/$rub/sort$rub.xml";
					my $output2="RESULTATS/$rub/sort$rub.txt";
					my $output3="RESULTATS/$rub/sort$rub.ttg.xml";

					#On ouvre les trois fichiers déjà existants
					# ">>" permet d'ajouter de l'information au fichier au lieu de le réecrire
					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 cet niveau là, on est sûr que quoi qu'il soit la rubrique du fichier en cours du traitement, il existe pour elle un dossier avec trois fichiers ouverts pour y enregistrer le resultat de filtrage et de l'etiquetage 	

#----------------------------------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;
			
				#On parcourt les 'items' du fichier (méthode standarte de la bibliothèque)
				foreach my $item(@{$rss->{'items'}}) {

					#Puis pour chaque element "item" on récupere son titre et sa description
					my $titre=$item->{'title'};
					my $description=$item->{'description'};

					#On les transforme, si necessaire, en utf-8 et on les nettoie
					if (uc($encodage) ne "UTF8") {utf8($titre);utf8($description);};
					$titre=&nettoietexte($titre);
					$description=&nettoietexte($description);

					#On increment 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 procedure de vérification des doublons est un peu modifié par rapport à BaO1
					#Ici, on procède au tratment de contenu de l'article seulement si le titre est original
					
					#Si le titre n'existait avant...
					if (!(exists($titleDic{$titre}))) {

						#On l'etiquette grâce à une fonction définie en bas
						my $titreetiq=&etiqttg($titre);

						#Et on enregistre le resultat dans les trois variables de sortie
						$DUMPFULL_TXT.="Titre : ".$titre." \n";
						$TOTAL_TXT.=$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";
							$TOTAL_TXT.=$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'élement article
					$DUMPFULL_XML.="</article>\n";
					$DUMPFULL_TTG.="</article>\n";
 
				} #ferme foreach item

			#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;
			print TOTAL $TOTAL_TXT;	
		} #ferme if
		
		close (FILEIN);
		
	} #ferme if
	}
	}
	} #ferme foreach file
	
}


#---------------------INITIALISATION DE LA FONCTION DE NETTOYAGE---------------------------------------------------
#Une fonction fourni 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;
	$texte=~s/&quot;/"/g;
    return $texte;
}

#-----------------------FONCTION D'ETIQUETTAGE----------------------------------
#Pour etiquetter 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 rend en sortie un fichier aussi en format texte, avec trois colonnes : token, catègorie, lemme

sub etiqttg {

	#On récupere l'argument passé à la fonction (soit le texte extrait)
	my ($texte)=@_;

	my $codage="utf-8";	
	my $texteetiq="";
	my $tmptag="texteaetiqueter.txt";

	#On ouvre un fichier temporaire pour formater l'entrée de Treetagger
	open (TMPFILE,">:encoding(utf-8)", $tmptag);

	#On y stocke notre texte à etiquetter
	print TMPFILE $texte,"\n";
	close(TMPFILE);

	#On lance une petite cascade des programmes où le 1r, 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");

    	# lecture du resultat tagge en xml :
	#La primière ligne du fichier n'est par prise en compte, c'est la préambule xml
	open(OUT,"<:encoding(utf-8)","treetagger.txt.xml");
	my $fistline=<OUT>;
	my $titreetiquete="";
	while (my $l=<OUT>) {
		$texteetiq.=$l;
	}
	close(OUT);

	#Enfin, la fonction rend le texte etiqueté
	return ($texteetiq);
}
