#/usr/bin/perl
use utf8;
use open ':utf8';
binmode(STDIN,":utf8");
binmode(STDOUT,":utf8");
<<DOC; 
JANVIER 2018
 usage : perl nom_programme.pl repertoire-a-parcourir "flux à traiter"
 Le programme prend en entrée le nom du répertoire contenant les fichiers à traiter et le code du flux RSS
DOC
#------------------------------------------------------------------
#on récupère le nom du répertoire, fourni en argument au programme
my $rep="$ARGV[0]";
# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
#identifiant rubrique 
my $rubrique="$ARGV[1]";
#on crée une mémoire des titres rencontrés sous forme de table de hashage
my %dicoTitres;
#on crée les fichiers qui vont accueillir les résultats
open(FILEOUT1,">:encoding(utf-8)","./sorties/sortie_$rep-$rubrique.txt");#on ouvre le fichier de sortie
open(FILEOUT2,">:encoding(utf-8)","./sorties/sortie_$rep-$rubrique.xml");
#preparation du document xml
print FILEOUT2 "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";
#------------------------------------------------------------------
$compteur=0; #initialisation du compteur d'item
$nom="";
print FILEOUT2 "<extraction type=\"$rubrique\">\n"; #racine du doc XML
print FILEOUT2 "<etudiant><prenom>Aline</prenom><nom>ETIENNE</nom><num>21404015</num></etudiant>\n";
&parcoursarborescencefichiers($rep);	# on lance la récursion.... et elle se terminera après examen de toute l'arborescence
print FILEOUT2 "</extraction>";
close FILEOUT1;
close FILEOUT2;
#------------------------------------------------------------------
exit;
#------------------------------------------------------------------
#la fonction qui suit fonctionne comme la fonction facto()
sub parcoursarborescencefichiers {
    my $path = shift(@_); #on récupère le nom du répertoire fourni en arg de la fonction
	#on ouvre le répertoire fourni en arg	
    opendir(DIR, $path) or die "can't open $path: $!\n"; #DIR=handler de répertoire
	#on lit le répertoire grâce à readdir ==> renvoie une liste du contenu ~ ls en bash
    my @files = readdir(DIR);
    closedir(DIR);
	
    foreach my $file (@files) {
		#on élimine les répertoires . et .. pour ne pas se retrouver bloqué dans une boucle grâce à next
		#next permet de passer au prochain élément de la liste si l'élément correspond à la regEx
		next if $file =~ /^\.\.?$/;
		#on crée le chemin relatif complet vers les objets
		$file = $path."/".$file;
		#on teste s'il s'agit d'un répertoire ; -d est vrai s'il s'agit d'un répertoire
		if (-d $file) {
			print "<NOUVEAU REPERTOIRE> ==> ",$file,"\n";
			&parcoursarborescencefichiers($file);	#recurse!
			print "<FIN REPERTOIRE> ==> ",$file,"\n";
		}
		
		#on teste s'il s'agit d'un fichier ==> condition d'arrêt : quand on arrive sur un fichier, car on ne relance par de parcours !
		if (-f $file) {			
			#si le fichier est un fichier .xml et correspond bien à la rubrique souhaitée
			#si on ne spécifie pas de rubrique, on peut avoir qqs soucis à cause des autres fichiers .xml présents dans les répertoires
			#donc on a ajouté 0,2- dans la regEx
			if ($file =~m/0\,2\-$rubrique.+\.xml$/){
				$nom=$file;
				print "<",$i++,"> ==> ",$file,"\n";
				
				#TRAITEMENT DES FICHIERS XML
				#on déclare la variable qui va accueillir la concaténation du texte extrait
				my $ensemble=""; 
				open(FILEIN,"<:encoding(utf8)",$file); #on ouvre le fichier rentré en argument en lecture
				#on lit le fichier ligne à ligne
				while (my $ligne=<FILEIN>){ #le my veut dire ici que $ligne n'existe qu'à cet endroit : déclarée localement
					chomp $ligne; #on enlève les retours à la ligne à la fin de chaque ligne
					$ligne =~ s/\r//g; #au cas où, on enlève aussi les traces de retour Windows
					$ensemble = $ensemble . $ligne;	 #on concatène tout le fichier dans la même variable
				}
				
				print FILEOUT2 "<fichier nom=\"$nom\">\n";
				$ensemble=~s/>\s+</></g; #on enlève tous les espaces, retours à la ligne etc. entre les balises
				$ensemble=~s/<description\/>/<description> <\/description>/g; #pour pouvoir récupérer tous les titres avec une seule RegEx
				while ($ensemble=~/<item><link>.+?<\/link><title>([^<]+?)<\/title><description>([^<]+?)<\/description>/g){ #on parcourt tout l'ensemble pour trouver les balises title et description et on mémorise leur contenu
					my $title=$1;
					my $description=$2;			
					$compteur++; #incrémentation compteur d'item					
					#si la clé n'existe pas on ajoute la clé dans le dico et on traite le titre ==> évite les doublons !!
					if (!(exists ($dicoTitres{$title}))) {
						$dicoTitres{$title}=1;
						my($titre_propre,$description_propre) = &nettoyage($title,$description); 
						print FILEOUT1 "\§$titre_propre\n$description_propre\n";
						print FILEOUT2 "\t<item num=\"$compteur\">\n\t\t<titre>$titre_propre</titre>\n\t\t<description>$description_propre</description>\n\t</item>\n";
					}
				}
				print FILEOUT2 "</fichier>\n";
				close FILEIN;
			}
			
		}
    }
}
#------------------------------------------------------------------
#procédure de nettoyage
sub nettoyage {
	my ($t,$d)=@_;
		
	$d=~s/&lt;.+?&gt;//g;#on veut supprimer les succession de balises transcodées $lt; &gt;	
	$d=~s/&#38;#39;/'/g;#on veut également remplacer les apostrophes transcodées &#38;#39;	
	$d=~s/&#38;#34;/"/g;#remplacement des guillemets doubles &#38;#34;
	$d=~s/&amp;/&/g;
	$d=~s/ / /g; #on remplace les espaces insécables par des espaces 'normaux'
	$d=~s/ //g;
	
	$t=~s/&lt;.+?&gt;//g;
	$t=~s/&#38;#39;/'/g;
	$t=~s/&#38;#34;/"/g;
	$t=~s/&amp;/&/g;
	$t=~s/ / /g;
	$t=~s/ //g;
	
	#pour faciliter segmentation plus tard, on ajoute un point au titre (qui n'en a souvent pas)
	$t.=".";
	$t=~s/\.\.$/\./; #au cas où, on remplace un éventuel double . final en un seul
	
	return $t,$d;
}