# Le script trie les fils par rubrique
# Au fur et à mesure de l'extraction, il crée un fichier en format XML et un fichier en format TXT


#!/usr/bin/perl
use strict;
use Unicode::String qw(utf8);
use HTML::Entities;
use XML::RSS;

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

my $sortie="Sorties/";
if (! -e $sortie){	
	mkdir($sortie) or die ("Problème à la création du répertoire : $!");
}

$sortie="Sorties/BAO1/";
if (! -e $sortie){
	mkdir($sortie) or die ("Problème à la création du répertoire : $!");
}

my %dicoTITRES=();
my %dicoDESC=();
my %refrubrik=();

#######################
&cherchenomrubrique($rep); #fonction d'extraction du nom des rubriques
#######################
    
my @liste_rubriques = keys(%refrubrik);    

foreach my $rub (@liste_rubriques) { # parcours de la liste des rubriques et création des fichiers de destination des données extraites
    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);
}
#######################
&recursearborepertoires($rep); #parcours récursivement les répertoires pour traiter automatiquement tout le corpus
#######################

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;

#######################
# Parcours des répertoires et traitement des fichiers de fils rss 
#######################
sub recursearborepertoires {
    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) {
	    &recursearborepertoires($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);

		# recherche de l'encodage indiqué dans l'entête du fichier
		$texte=~/encoding ?= ?[\'\"]([^\'\"]+)[\'\"]/i;
		my $encodage=$1;
		print "ENCODAGE : $encodage\n";
		if ($encodage ne "") {           
		    my $texteXML="<file>\n";		#génération d'un fichier de sortie XML bien formé
			$texteXML.="<name>$file</name>";
		    $texteXML.="<items>\n";
		    my $texteBRUT="";
		    open(FILE,"<:encoding($encodage)", $file); #génération d'un fichier de sortie format texte
		    $texte="";
		    while (my $ligne=<FILE>) {
			$ligne =~ s/\n//g;
			$ligne =~ s/\r//g;
			$texte .= $ligne;
		    }
		    close(FILE);
			$texte =~ s/> *</></g;			# suppressiondes espaces entre les fins et débuts de balises
		    ############################
		    # 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; #suppression du texte répété 
			$rub=~s/\x{E8}/e/g;  # traitement des caractères diachrités : è
			$rub=~s/\x{E0}/a/g;  # à 
			$rub=~s/\x{E9}/e/g;  # é
			$rub=~s/\x{C9}/e/g;  # É  
		    $rub=~s/ //g;
		    $rub=uc($rub);
		    $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"};
		    ###############################
		    # Utilisation du module XML::RSS pour extraire titre et description
		    # Création de l'objet $rss pour parser les fichiers de données
		    ##############################
			my $rss = new XML::RSS;
			$rss->parsefile($file);
			
			foreach my $item(@{$rss->{'items'}}){
				my $titre = $item->{'title'};
				my $desc = $item->{'description'};

				if (uc($encodage) ne "UTF-8"){
				   utf8($titre);
				   utf8($desc);
				}
				
				# traitement des caractère diachrités avec le module HTML::Entities
				$titre = HTML::Entities::decode($titre);
				$desc = HTML::Entities::decode($desc);
				$titre = &nettoyagetxt($titre);
				$desc = &nettoyagetxt($desc);

				# élimination des doublons
				if (!(exists $dicoTITRES{$titre}) and (!(exists $dicoDESC{$desc}))){	 
					$dicoTITRES{$titre}++;
					$dicoDESC{$desc}++;
					$texteXML.="<item>\n<title>$titre</title>\n<description>$desc</description>\n</item>\n";  
					print OUTTXT "$titre\n";
					print OUTTXT "$desc\n";
				}
		    }
		    $texteXML.="</items>\n</file>\n";
		    
		    print OUTXML $texteXML;
		    print OUTTXT $texteBRUT;

		    close(OUTXML);
		    close(OUTTXT);
		}
		else {
		    print "$file ==> encodage non détecté \n";
		}
	    }
	}
	}
}
################################
# nettoyage des éléments non textuels dans les titres et descriptions : liens et images notamment

sub nettoyagetxt {
    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; # caractère de remplacement
	$texte=~s/\x{20ac}/€/g;
	$texte=~s/\x{2009}/ /g; # espace court
	return $texte;
}

#######################
# - Parcours des fichiers pour repérer les rubriques
#######################
sub cherchenomrubrique {
    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) {
	    &cherchenomrubrique($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;
		if ($encodage ne "") {
		    open(FILE,"<:encoding($encodage)", $file);
		    $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;
			# Passage en lettres capitales       
			$rub=uc($rub);  
			$rub=~s/-LEMONDE.FR//g;  
			$rub=~s/:TOUTEL'ACTUALITESURLEMONDE.FR.//g;
			# stockage des rubriques 
			$refrubrik{$rub}++;    
		    }
		}
		else {
		    print "$file ==> encodage non détecté \n";
		}
	    }
	}
	}
}