#!/usr/bin/perl
#charger le module unicode (faire un import)
use Unicode::String qw(utf8);
#-----------------------------------------------------------
#recuperer le nom du repertoire racine du corpus
my $rep="$ARGV[0]";
#rechercher/remplacer pour s'assurer que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
#initialiser les variables contenant le flux de sortie
my %dictionnairedesitems=();
my %dictionnairesdesrubriques=();
#----------------------------------------
#recuperer les rubriques
&parcoursarborescencefichierspourrepererlesrubriques($rep);
#----------------------------------------
#creer une liste avec les noms des rubriques
my @liste_rubriques = keys(%dictionnairesdesrubriques);
#pour chaque nom de la liste des rubriques
foreach my $rub (@liste_rubriques) {
    print $rub,"\n";
    #----------------------------------------
    #ouvrir le fichier de sortie avec le nom de la rubrique
    my $output1="SORTIE-".$rub.".xml";
    my $output2="SORTIE-".$rub.".txt";
    #si l'ouverture du fichier se passe mal le programme s'arrete et renvoie un message    
    if (!open (FILEOUT1,">:encoding(utf-8)", $output1)) { die "Pb a l'ouverture du fichier $output1"};
    if (!open (FILEOUT2,">:encoding(utf-8)",$output2)) { die "Pb a l'ouverture du fichier $output2"};
    #formater la sortie pour creer un fichier xml avec entete
    print FILEOUT1 "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
    print FILEOUT1 "<PARCOURS>\n";
    close(FILEOUT1);
    close(FILEOUT2);
}
#----------------------------------------
#traiter les fichiers du fil RSS
&parcoursarborescencefichiers($rep);
#----------------------------------------
#pour chaque nom de la liste des rubriques
foreach my $rub (@liste_rubriques) {
    #ouvrir le fichier de sortie avec le nom de la rubrique
    my $output1="SORTIE-".$rub.".xml";
    #si l'ouverture du fichier se passe mal le programme s'arrete et renvoie un message
    if (!open (FILEOUT1,">>:encoding(utf-8)", $output1)) { die "Pb a l'ouverture du fichier $output1"};
    print FILEOUT1 "</PARCOURS>\n";
    close(FILEOUT1);
}
exit;
#----------------------------------------------
#----------------------------------------------
sub parcoursarborescencefichiers {
    #enlever le premier element de la liste des arguments passes a la procedure
    my $path = shift(@_);
    #ouvrir le repertoire et afficher un message si l'ouverture se passe mal
    opendir(DIR, $path) or die "can't open $path: $!\n";
    #lire le repertoire precedemment ouvert et renvoyer la liste des noms de ces elements
    my @files = readdir(DIR);
    closedir(DIR);
    #parcourir la liste des elements pour connaitre le contenu du repertoire
    foreach my $file (@files) {
	#si le nom du fichier est equivalent a "." ou ".." passer au suivant dans le traitement de la liste
	next if $file =~ /^\.\.?$/;
	#reconstruire le chemin pour travailler avec
	$file = $path."/".$file;
	#lancer de nouveau la procedure a chaque fois qu'on trouve un repertoire
	if (-d $file) {
	    &parcoursarborescencefichiers($file);
	}
	#si $file est un fichier (sinon on ne rentre pas dans la boucle)
	if (-f $file) {
	    ########TRAITEMENT à réaliser sur chaque fichier#########
	    if (($file=~/\.xml$/) && ($file!~/\/fil.+\.xml$/)) {
		open(FILE, $file);
		print "Traitement de :\n$file\n";
		#initialiser une variable pour recuperer le contenu du fichier
		my $texte="";
		#lire ligne par ligne le fichier
		while (my $ligne=<FILE>) {
		    $ligne =~ s/\n//g;
		    $texte .= $ligne;
		}
		close(FILE);
		#rechercher la balise encoding
		$texte=~/encoding ?= ?[\'\"]([^\'\"]+)[\'\"]/i;
		my $encodage=$1;
		print "ENCODAGE : $encodage \n";
		#si l'encodage est detecte
		if ($encodage ne "") {
		    #formater la sortie
		    my $tmptexteXML="<file>\n";
		    $tmptexteXML.="<name>$file</name>\n";
		    $texte =~ s/> *</></g;
		    $texte=~/<pubDate>([^<]+)<\/pubDate>/;
		    $tmptexteXML.="<date>$1</date>\n";
		    $tmptexteXML.="<items>\n";
		    my $tmptexteBRUT="";
		    open(FILE,"<:encoding($encodage)", $file);
		    print "Traitement de :\n$file\n";
		    $texte="";
		    while (my $ligne=<FILE>) {
			$ligne =~ s/\n//g;
			$texte .= $ligne;
		    }
		    close(FILE);
		    $texte=~s/> *</></g;
		    #rechercher la rubrique
		    $texte=~/<title>([^<]+)<\/title>/;
		    my $rub=$1;
		    #formater la rubrique
		    $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/-LEMONDE.FR//gi;
		    #mettre le nom de la rubrique en majuscule
		    $rub=uc($rub);
		    print $rub,"\n";
		    #----------------------------------------
		    #ouvrir le fichier de sortie
		    my $output1="SORTIE-".$rub.".xml";
		    my $output2="SORTIE-".$rub.".txt";
		    #si l'ouverture du fichier se passe mal le programme s'arrete et renvoie un message
		    if (!open (FILEOUT1,">>:encoding(utf-8)", $output1)) { die "Pb a l'ouverture du fichier $output1"};
		    if (!open (FILEOUT2,">>:encoding(utf-8)", $output2)) { die "Pb a l'ouverture du fichier $output2"};
		    #----------------------------------------
		    #extraction du contenu des balises title et description (titre et resume)
		    while ($texte =~ /<item><title>(.+?)<\/title>.+?<description>(.+?)<\/description>/g) {
			my $titre=$1;
			my $resume=$2;
			print "T : $titre \n R : $resume \n";
			#si l'encodage n'est pas utf8 faire un transcodage
			if (uc($encodage) ne "UTF-8") {utf8($titre);utf8($resume);}
			#nettoyer le contenu des balises title et description
			$titre = &nettoietexte($1);
			$resume = &nettoietexte($2);
			#si le resume existe mettre un marqueur au debut de la ligne pour le titre
			if (!(exists($dictionnairedesitems{$resume}))) {
			    $tmptexteBRUT.="§ $titre \n";
			    $tmptexteBRUT.="$resume \n";
			    $tmptexteXML.="<item><title>$titre</title><abstract>$resume</abstract></item>\n";
			    $dictionnairedesitems{$resume}++;
			}
			else {
			    $dictionnairedesitems{$resume}++;
			}
		    }
		    #fermeture des balises item et file
		    $tmptexteXML.="</items>\n</file>\n";
		    print FILEOUT1 $tmptexteXML;
		    print FILEOUT2 $tmptexteBRUT;
		    close FILEOUT1;
		    close FILEOUT2;
		}
		else {
		    print "$file ==> $encodage \n";
		}
	    }
	}
    }
}
#----------------------------------------------------
sub nettoietexte {
    my $texte=shift;
	#rechercher remplacer les entites
    $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/&amp;/ et /g;
	$texte=~s/&#039;/'/g;	
	$texte=~s/&/et/g;
    return $texte;
}
#-----------------------------------------------------------------------------------
sub parcoursarborescencefichierspourrepererlesrubriques {
    #enlever le premier element de la liste des arguments passes a la procedure
    my $path = shift(@_);
    #ouvrir le repertoire
    opendir(DIR, $path) or die "can't open $path: $!\n";
    #lire le repertoire precedemment ouvert et renvoyer la liste des noms de ces elements
    my @files = readdir(DIR);
    closedir(DIR);
    #parcourir la liste des elements pour savoir ce qu'il y a dans le repertoire
    foreach my $file (@files) {
	#si le nom du fichier est equivalent a "." ou ".." on passe au suivant dans le traitement de la liste
	next if $file =~ /^\.\.?$/;
    #reconstruire le chemin pour travailler avec
	$file = $path."/".$file;
	#lancer de nouveau la procedure a chaque fois qu'on trouve un repertoire
	if (-d $file) {
	    &parcoursarborescencefichierspourrepererlesrubriques($file);
	}
	#si $file est un fichier (sinon on ne rentre pas dans la boucle)
	if (-f $file) {
	    ########TRAITEMENT à réaliser sur chaque fichier#########
	    if (($file=~/\.xml$/) && ($file!~/\/fil.+\.xml$/)) {
		open(FILE,$file);
		print "Traitement de :\n$file\n";
		#initialiser une variable pour recuperer le contenu du fichier
		my $texte="";
		#lire ligne a ligne le fichier
		while (my $ligne=<FILE>) {
		    $ligne =~ s/\n//g;
		    $texte .= $ligne;
		}
		close(FILE);
		#rechercher la balise encoding
		$texte=~/encoding ?= ?[\'\"]([^\'\"]+)[\'\"]/i;
		my $encodage=$1;
		#si l'encodage est detecte
		if ($encodage ne "") {
		    open(FILE,"<:encoding($encodage)", $file);
		    print "Traitement de :\n$file\n";
		    $texte="";
		    while (my $ligne=<FILE>) {
			$ligne =~ s/\n//g;
			$texte .= $ligne;
		    }
		    close(FILE);
		    $texte =~ s/> *</></g;
		    #rechercher la rubrique
		    if ($texte=~ /<channel><title>([^>]+)<\/title>/) {
			my $rub=$1;
			#formater la rubrique
			$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/-LEMONDE.FR//gi;
			#mettre le nom de la rubrique en majuscule
			$rub=uc($rub);
			$dictionnairesdesrubriques{$rub}++;
		    }
		}
		else {
		    print "$file ==> $encodage \n";
		}
	    }
	}
    }
}
#----------------------------------------------