#!/usr/bin/perl
use strict;
use Unicode::String qw(utf8);
#utilisation de la bibliotheque HTML::Entities qui fait la meme chose que la fonction nettoyage creee precedemment cad remplace les entites HTML par les caracteres correspondants
use HTML::Entities;

my $rep="$ARGV[0]";
# on s'assure que le nom du repertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;        
#creation des repertoires de sortie pour que les fichiers soient ranges
my $sortie="Sorties/";
if (! -e $sortie){	
	mkdir($sortie) or die ("Pb a la creation du repertoire : $!");
}

$sortie="Sorties/BAO1/";
if (! -e $sortie){
	mkdir($sortie) or die ("Pb a la creation du repertoire : $!");
}

#initialisation des variables contenant les flux de sortie
my %dictionnairetitres=();
my %dictionnaireresumes=();
my %dictionnairerubriques=();

&repererubriques($rep);  
    
my @liste_rubriques = keys(%dictionnairerubriques);    
# parcours de la liste des rubriques et creation des fichiers
foreach my $rub (@liste_rubriques) {
    #print $rub,"\n";
    my $output1 = $sortie.$rub.".xml"; 
    my $output2 = $sortie.$rub.".txt";
    if (!open (OUTXML,">:encoding(utf-8)", $output1)) { die "Can't open file $output1"};   
    if (!open (OUTTXT,">:encoding(iso-8859-1)", $output2)) { die "Can't open file $output2"};   
    print OUTXML "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
    print OUTXML "<EXTRACTION>\n";
    close(OUTXML);
    close(OUTTXT);
}

&parcoursarborescencefichiers($rep);

foreach my $rub (@liste_rubriques) {
    my $output1=$sortie.$rub.".xml";
    if (!open (OUTXML,">>:encoding(utf-8)", $output1)) { die "Can't open file $output1"};
    print OUTXML "</EXTRACTION>\n";
    close(OUTXML);
}
exit;

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$/) && ($file!~/\/fil.+\.xml$/)) {
				open(FILE, $file);
				print "Traitement de : $file\n";
				my $texte="";
				while (my $ligne=<FILE>) {
		    		$ligne =~ s/\n//g;
		    		$ligne =~ s/\r//g;
		    		$texte .= $ligne;
				}
				close(FILE);
				$texte=~s/> *</></g;
				# recherche de l'encodage
				$texte=~/encoding ?= ?[\'\"]([^\'\"]+)[\'\"]/i;
				my $encodage=$1;
				print "ENCODAGE : $encodage\n";
				# si l'encodage n'est pas vide, faire le traitement...
				if ($encodage ne "") {
		    		my $texteXML="<file>\n";
					$texteXML.="<name>$file</name>";
		    		$texteXML.="<items>\n";
		    		my $texteBRUT="";
		    		open(FILE,"<:encoding($encodage)", $file);
		    		$texte="";
					# suppression des sauts de ligne
		    		while (my $ligne=<FILE>) {
						$ligne =~ s/\n//g;
						$ligne =~ s/\r//g;
						$texte .= $ligne;
		    		}
		    		close(FILE);
					# supprimer les espaces entre les balises
					$texte=~s/> *</></g;
		    		# recherche de la rubrique
		    		$texte=~/[<channel>|<atom.+>]<title>([^<]+)<\/title>/;
		    		my $rub=$1;
		    		$rub=~s/Le ?Monde.fr ?://g;
					$rub=~s/ ?: ?Toute l'actualité sur Le Monde.fr.//g;
					$rub=~s/\x{E8}/e/g;  # è
					$rub=~s/\x{E0}/a/g;  # à  
					$rub=~s/\x{E9}/e/g;  # é
					$rub=~s/\x{C9}/e/g;  # É  
		    		$rub=~s/ //g;
		    		$rub=uc($rub); # mise en majuscules
		    		$rub=~s/-LEMONDE.FR//g;
					$rub=~s/:TOUTEL'ACTUALITESURLEMONDE.FR.//g;
		    		print "RUBRIQUE : $rub\n";
		    		
		    		my $output1=$sortie.$rub.".xml";
		    		my $output2=$sortie.$rub.".txt";
		    		if (!open (OUTXML,">>:encoding(utf-8)", $output1)) { die "Can't open file $output1"};
		    		if (!open (OUTTXT,">>:encoding(iso-8859-1)", $output2)) { die "Can't open file $output2"};
		    		
					# Stockage des titres et resumes dans des variables
		    		while ($texte =~ /<item><title>(.+?)<\/title>.+?<description>(.+?)<\/description>/g) {
						my $titre=$1;
						my $resume=$2;

						# si l'encodage n'est pas UTF-8, reencoder via le module Unicode::String
						if (uc($encodage) ne "UTF-8"){
				   			utf8($titre);
				   			utf8($resume);
						}
				
						# traiter les caracteres accentues avec HTML::Entities
						$titre = HTML::Entities::decode($titre);
						$resume = HTML::Entities::decode($resume);
						$titre = &clean($titre);
						$resume = &clean($resume);

						# supprimer les eventuels doublons
						if (!(exists $dictionnairetitres{$titre}) and (!(exists $dictionnaireresumes{$resume}))){	 
							$dictionnairetitres{$titre}++;
							$dictionnaireresumes{$resume}++;
							$texteXML.="<item>\n<title>$titre</title>\n<description>$resume</description>\n</item>\n";  
							print OUTTXT "$titre\n";
							print OUTTXT "$resume\n";
						}
		    	}
		    	$texteXML.="</items>\n</file>\n";
		    
		    	print OUTXML $texteXML;
		    	print OUTTXT $texteBRUT;

		    	close(OUTXML);
		    	close(OUTTXT);
			}
			# ...sinon, afficher un message
			else {
		    	print "$file ==> encodage non détecté \n";
			}
		}
	}
	}
}
 
# + remplacement des caracteres speciaux
sub clean {
    my $texte=shift;
	$texte=~s/<img[^>]+>//g;
	$texte=~s/<a href[^>]+>//g;
	$texte=~s/<\/a>//g;
	$texte=~s/<[^>]+>//g;
	$texte=~s/&/et/g;
	$texte=~s/\x{201c}/“/g;
	$texte=~s/\x{201d}/”/g;
	$texte=~s/\x{2019}/'/g;
	$texte=~s/\x{2018}/‘/g;
	$texte=~s/\x{2013}/-/g;
	$texte=~s/\x{2192}/→/g;
	$texte=~s/\x{2026}/.../g;
	$texte=~s/\x{0153}/Å“/g; 
	$texte=~s/\x{0152}/Å’/g;
	$texte=~s/\x{fffd}/�/g; # caractere de remplacement
	$texte=~s/\x{20ac}/€/g;
	$texte=~s/\x{2009}/ /g; # espace court
	return $texte;
}

# - Parcours de l'arborescence pour reperer les rubriques - 

sub repererubriques {
    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) {
	    	&repererubriques($file);	
		}
		if (-f $file) {
	    	if (($file=~/\.xml$/) && ($file!~/\/fil.+\.xml$/)) {
				open(FILE,$file);
				#print "Traitement de : $file\n";
				my $texte="";
				while (my $ligne=<FILE>) {
		    		$ligne =~ s/\n//g;
		    		$ligne =~ s/\r//g;
		    		$texte .= $ligne;
				}
				close(FILE);
				$texte=~s/> *</></g;
				$texte=~/encoding ?= ?[\'\"]([^\'\"]+)[\'\"]/i;
				my $encodage = $1;
				#print "ENCODAGE : $encodage\n";
				if ($encodage ne "") {
		    		open(FILE,"<:encoding($encodage)", $file);
		    		#print "Traitement de :\n$file\n";
		    		$texte="";
		    		while (my $ligne=<FILE>) {
						$ligne =~ s/\n//g;
						$ligne =~ s/\r//g;
						$texte .= $ligne;
		    		}
		    		close(FILE);
		    		$texte =~ s/> *</></g;
		    		if ($texte=~ /[<channel>|<atom.+>]<title>([^<]+)<\/title>/) {
						my $rub=$1;
						$rub=~s/Le ?Monde.fr ?://g;
						$rub=~s/ ?: ?Toute l'actualité sur Le Monde.fr.//g;
						$rub=~s/\x{E8}/e/g;  # è
						$rub=~s/\x{E0}/a/g;  # Ã  
						$rub=~s/\x{E9}/e/g;  # é
						$rub=~s/\x{C9}/e/g;  # É         
						$rub=~s/ //g;      
						$rub=uc($rub);  # mise en majuscules
						$rub=~s/-LEMONDE.FR//g;  
						$rub=~s/:TOUTEL'ACTUALITESURLEMONDE.FR.//g;
						# memoriser les rubriques 
						$dictionnairerubriques{$rub}++;    
		    		}
				}
				else {
		    		print "$file ==> encodage non détecté \n";
				}
	    	}
		}
		}
}