#/usr/bin/perl
<<DOC; 
-------------------------------------------------------------------------
Nom : Aurore LESSIEUX & Corentin VIALAR
Date : MARS 2020
Action : parcours une arborescence de fil RSS, extrait et nettoie les contenus textuels des titres et des descriptions en utilisant les expressions régulières.

Commande de lancement : perl bao1_v-perl_regex.pl REPERTOIRE_A_PARCOURIR RUBRIQUE_A_EXTRAIRE

ENTREE : le programme prend en entrée le nom du répertoire contenant les fichiers à traiter + la rubrique 
SORTIE : le programme crée en sortie 2 fichiers :
		- Un fichier au format texte brute(txt)
		- Un fichier structuré au format XML, contenant le contenu textuel du résultat du filtrage :			
			<BAO_1>
				<NOM>du fichier</NOM>
				<fichiers>contenu du filtrage</fichiers>
			</BAO_1>
-------------------------------------------------------------------------
DOC
#----------------------------------------------------------------------
#On récupère dans 2 variables les arguments passés au programme :
my $rep="$ARGV[0]";	#pour le répertoire à traiter
my $rubrique = "$ARGV[1]";	#la rubrique souhaitée

# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;

#-----------------------------------------------------------

#on déclare et ouvre les fichiers de sortie en mode écriture :
open(OUT,">:encoding(utf8)", "BAO1_sortie_$rubrique.txt"); 
open(OUTXML, ">:encoding(utf8)", "BAO1_sortiexml_$rubrique.xml");


#on écrit la tête du fichier XML :
print OUTXML "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";


print OUTXML "<BAO_1>\n"; #Déclaration de la racine
#les auteurs
print OUTXML "\t<auteur>Aurore LESSIEUX</auteur>\n"; 
print OUTXML "\t<auteur>Corentin VIALAR</auteur>\n";
print OUTXML "\t<NOM>Rubrique : $rubrique</NOM>\n";

#l'ensemble des données extraites
print OUTXML "<fichiers>\n";

#on initialise un compteur et une talbe de hachage (dictionnaire en python) pour traiter les éventuels doublons :
my %dico_des_titres =();
my $i = 0;


#-----------------------------------------------------------
#Appel d'un sous-programme qui va parcourir l'arborescence de manière récursive :
&parcoursarborescencefichiers($rep);
#on passe le repertoire contenant les fichiers à traitées en argument du sous-programme

#-----------------------------------------------------------
#fermeture des fichiers :
close(OUT); #fermeture du fichier texte

print OUTXML "\t</fichiers>\n";
print OUTXML "</BAO_1>\n";
close(OUTXML); #fermeture du fichier XML

exit;

#-----------------------------------------------------------

#Le sous-programme qui prend en argument le répertoire à traiter:
#(sous-programmemme récursif)
sub parcoursarborescencefichiers {
	#------------on récupère la racine du chemin
	#shift prend le premier élément de la liste et le renvoie :
	my $path = shift(@_);
	
	#------------ouverture du contenue du répertoire :
	#on sait que la racine est un dossier donc utilisation d'"opendir"
	opendir(DIR, $path) or die "can't open $path: $!\n";
	
	#-----------lecture du répertoire :
	#renvoie une liste de ressource du répertoire
	my @files = readdir(DIR);#examiner la liste de ressource
	
	#fermeture du répertoire :
	closedir(DIR);
	
	#boucle sur chacun des éléments de la liste des ressources du répertoire:
	foreach my $file (@files) {	
		#on passe au fichier suivant si le fichier est caché : "." ou ".." ; sinon on risque de créer une boucle sur le répertoire courant
		next if $file =~ /^\.\.?$/;
		
		#reconstruction du chemin relatif où l'on se trouve :
		$file = $path."/".$file;
		
		#si le chemin relatif conduit à un répertoire :
		# -d permet de vérifier que $file est un répertoire
		if (-d $file) {	
			#si on est dans un répertoire, on recommence toute la procédure avec un nouveau chemin passé en argument :
			&parcoursarborescencefichiers($file);	#recurse!
		}
		
		#si le chemin relatif conduit à un fichier :
		#-f permet de vérifier que $fil est un fichier
		if (-f $file) {	
			#----------TRAITEMENT à réaliser sur chaque fichier :
			
			#-----------------------Lecture du fichier :
			#si le fichier a une EXTENSION XML et la RUBRIQUE passé en argument au programme :
			if ($file =~/$rubrique.+\.xml$/) {
				#incrémentation du compteur, message dans la console :
				print $i++, "Traitement de :", $file, "\n";
				print "##------------------------------------------##\n";
				
				#ouverture du fichier en mode lecture:
				open(FIC,"<:encoding(utf8)", $file);
				#lecture du fichier jusqu'à la fin en une seule fois
				$/=undef;
				my $textelu=<FIC> ;
				#fermeture du fichier
				close (FIC);
				
				#-------------------Extraction :
				
#-----BAO1 : perl - Expression régulière--------------------------------------
				#boucle qui extrait les titres et les descriptions à l'aide des expressions régulières
				while ($textelu =~ /<item>.*?<title>(.+?)<\/title>.+?<description>(.+?)<\/description>/gs) {
					#initialisation de variable pour stocker les titres et les descriptions séparément
					my $titre = $1;
					my $description = $2;
#-----------------------------------------------------------------------------					
					#---------------Nettoyage du texte :
					#A l'aide d'un autre sous-programme on nettoie les "cochonneries" des contenues textuelles qu'on a extrait
					($titre, $description) = &nettoyage($titre, $description);
					
					#--------------Traitement des doublons :
					#si le titre n'existe pas dans le dictionnaire $dico_des_titres :
					if (!(exists $dico_des_titres{$titre} )) {
						#alors il n'y a pas de doublon et on effectue le traitement suivant :
						#on ajoute le titre et la description au dictionnaire
						$dico_des_titres{$titre}=$description ; 

						#Ecriture des fichiers de sortie :
						#------------VERSION TXT---------------------
						print OUT "TITRE : ", $titre,"\n";
						print OUT "DESCRIPTION :", $description,"\n";
						print OUT "-------\n";
						
						#------------VERSION XML---------------------
						print OUTXML "\t\t<item>\n" ;
						print OUTXML "\t\t\t<titre>$titre</titre>\n";
						print OUTXML "\t\t\t<description>$description</description>\n";
						print OUTXML "\t\t</item>\n";
						
						#message dans la console :
						print "$file est le", $i++,"\n";
						
						#si le titre existe déjà dans le dictionnaire, on ne fait rien
					}
				}
			}
		}
    }
}

#----------------------------------------------

#le sous programme qui nettoie le contenu textuel extrait :
#Entrée : 2 variables textuelles
#Sortie : les 2 variables textuelles nettoyées
sub nettoyage {
	#récupérer ce qui a été passé en argument au programme : @ARGV 
	my $titre = $_[0];
	my $description = $_[1];
	
	#--------Nettoyage :
	#enlever les structures [CDATA[ ... ]]	
	$description=~s/^<;!\[CDATA\[//;
	$description=~s/\]\]&gt;$//;
	$titre=~s/^<;!\[CDATA\[//;
	$titre=~s/\]\]&gt;$//;
	
	#rempalcer le code par des guillemets simples :
	$description =~s/&#38;#39;/'/g;
	$titre =~s/&#38;#39;/'/g;
	
	#remplacer le code par des guillemets doubles :
	$description =~s/&#38;#34;/"/g;
	$titre =~s/&#38;#34;/"/g;
	
	#suppresion des balises
	$description =~s/&lt;.+?&gt;//g ;
	$titre =~s/&lt;.+?&gt;//g ;
	
	#remplacer & par "et":
	$description =~s/&/et/g ;
	$titre =~s/&/et/g ;
	
	#rajouter un point à la fin des titres
	$titre=~s/$/\./g;
	
	#renvoyer le contenu textuel nettoyé :
	return $titre, $description;
}