#/usr/bin/perl
use XML::RSS;
use utf8;
use open ':utf8';
binmode(STDIN,":utf8");
binmode(STDOUT,":utf8");
#use strict;
<<DOC; 
JANVIER 2018
 usage : perl5.16.3 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]";
my $rss=new XML::RSS;
# 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/bibliXML-RSS_sortie_$rubrique.txt");#on ouvre le fichier de sortie
open(FILEOUT2,">:encoding(utf-8)","./sorties/bibliXML-RSS_sortie_$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;
#------------------------------------------------------------------
system("unlink titre.txt");
system("unlink etiquetage_titre.txt");
system("unlink etiquetage_titre.txt.xml");
system("unlink description.txt");
system("unlink etiquetage_description.txt");
system("unlink etiquetage_description.txt.xml");
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
			if ($file =~m/0\,2\-$rubrique.+\.xml$/){
				$nom=$file;
				print "<",$i++,"> ==> ",$file,"\n";
				
				#TRAITEMENT DES FICHIERS XML
				eval {$rss->parsefile($file); };
				if( $@ ) {
					$@ =~ s/at \/.*?$//s;               # remove module line number
					print STDERR "\nERROR in '$file':\n$@\n";
				} 
				else {
					print FILEOUT2 "<fichier nom=\"$nom\">\n";
					foreach my $item (@{$rss->{'items'}}) {
					my $description=$item->{'description'};
					my $title=$item->{'title'};
					$title=~s/<[^>]+>//g;
					$description=~s/<[^>]+>//g;
					$compteur++; #compteur d'items					
					#si la clé n'existe pas on ajoute la clé 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";
						my($titre_etiquette,$description_etiquette)=&etiquetage($titre_propre,$description_propre);
						print FILEOUT2 "\t<item num=\"$compteur\">\n\t\t<titre>$titre_etiquette\t\t</titre>\n\t\t<description>$description_etiquette\t\t</description>\n\t</item>\n";
					}
					}
					print FILEOUT2 "</fichier>\n";
				}			
			}	
		}
	}
}
#------------------------------------------------------------------
#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;
}
#------------------------------------------------------------------
#procédure d'étiquetage
sub etiquetage {
	my ($t,$d)=@_;
	
	#on stocke le titre dans un fichier .txt
	open(TITRE,">:encoding(utf8)","titre.txt"); 
	print TITRE "$t\n";
	close TITRE;
	#on applique treetagger puis treetagger2xml
	system("perl tokenise-utf8.pl titre.txt | ./tree-tagger.exe -token -lemma -no-unknown french-utf8.par > etiquetage_titre.txt");
	system("perl treetagger2xml-utf8.pl etiquetage_titre.txt utf8");
	$/=undef; #on modifie la variable par défaut de lecture pour pouvoir lire le fichier globalement (et plus ligne à ligne)
	open (TITRE2,"<:encoding(utf8)","etiquetage_titre.txt.xml"); #on ouvre le résultat produit par treetagger2xml
	my $t_etiquette=<TITRE2>;
	$t_etiquette=~s/<\?xml version="1\.0" encoding="utf-8" standalone="no"\?>\r?\n?//; #on supprime éventuellement cette ligne
	close TITRE2;
	
	open(DESCRIPTION,">:encoding(utf8)","description.txt");
	print DESCRIPTION "$d\n";
	close DESCRIPTION;	
	system("perl tokenise-utf8.pl description.txt | ./tree-tagger.exe -token -lemma -no-unknown french-utf8.par > etiquetage_description.txt");
	system("perl treetagger2xml-utf8.pl etiquetage_description.txt utf8");
	open (DESCRIPTION2,"<:encoding(utf8)","etiquetage_description.txt.xml"); #on ouvre le résultat produit par treetagger2html
	my $d_etiquette=<DESCRIPTION2>;
	$d_etiquette=~s/<\?xml version="1\.0" encoding="utf-8" standalone="no"\?>\r?\n?//;
	close DESCRIPTION2;
	
	$/="\n"; #on n'oublie pas de remettre la valeur de la variable par défaut !!!
	return ($t_etiquette,$d_etiquette);
}