#/usr/bin/perl

#*************************************************************************************
#	BAO1 : extraire le contenu textuel des fils rss du Monde d'une année entière,
#		le stocker au format xml et txt
#*************************************************************************************

use open qw< :encoding(UTF-8) >;
my $rep="$ARGV[0]"; #corpus de fils rss
$rep=~ s/[\/]$//;# on s'assure que le nom du répertoire ne se termine pas par un "/"
my $rubrique = "$ARGV[1]";
my %nom_rubriques = (	3208 => "A LA UNE",
						3210 => "INTERNATIONAL",
						3214 => "EUROPE",
						3224 => "FRANCE",
						3226 => "SOCIETE",
						3228 => "ENVIRONNEMENT",
						3234 => "ENTREPRISES",
						3236 => "MEDIAS",
						3242 => "SPORTS",
						3244 => "SCIENCES",
						3246 => "CULTURE");
my %dico;

#------------------------------------------------------------------------------------
#		Initialisation des variables contenant le flux de sortie :
#		- surface (titre et description) : SURFACEXML , SURFACETXT 
#		- profondeur (articles) : PROFONDEURXML, PROFONDEUR
#------------------------------------------------------------------------------------
my $output1="$rubrique.xml";
$nom_rubrique=$nom_rubriques{$rubrique};
if (!open (SURFACEXML,">$output1")) { die "Pb a l'ouverture du fichier $output1"};
print SURFACEXML "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print SURFACEXML "<PARCOURS>\n";
print SURFACEXML "<rubrique>$nom_rubrique</rubrique>\n";
close (SURFACEXML);

my $output2="$rubrique.txt";
if (!open (SURFACETXT,">$output2")) {die "Problème à l'ouverture du fichier $output2"};
print SURFACETXT "Rubrique : $nom_rubrique\n";
close SURFACETXT;

my $output3="$rubrique"."-profondeur.xml";
if (!open (PROFONDEURXML,">$output3")) { die "Pb a l'ouverture du fichier $output3"};
print PROFONDEURXML "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print PROFONDEURXML "<PARCOURS>\n";
print PROFONDEURXML "<rubrique>$nom_rubrique</rubrique>\n";
close (PROFONDEURXML);

my $output4="$rubrique"."-profondeur.txt";
if (!open (PROFONDEUR,">$output4")) {die "Problème à l'ouverture du fichier $output4"};
print PROFONDEUR "Rubrique : $nom_rubrique\n";
close PROFONDEUR;

#----------------------------------------
&parcoursarborescencefichiers($rep);	
#----------------------------------------
open (SURFACEXML,">>", $output1);
print SURFACEXML "</PARCOURS>\n";
close(SURFACEXML);

open (PROFONDEURXML, ">>", $output3);
print PROFONDEURXML "</PARCOURS>\n";
close (PROFONDEURXML);
exit;
#----------------------------------------
#PROCEDURE : parcourir l'arborescence du répertoire -> extraire le contenu textuel des fichiers
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;   #2016/01/19,00,00
		#si $file est un répertoire
		if (-d $file) {
			print "<NOUVEAU REPERTOIRE> ==> ",$file,"\n";
			&parcoursarborescencefichiers($file);	#recurse!
			print "<FIN REPERTOIRE> ==> ",$file,"\n";
		}
		#si $file est un fichier
		if (-f $file) {  
	      		#extraire la surface (titre et description)
		    	if ($file =~ /$rubrique.+\.xml$/) {		        
					print "<",$i++,"> ==> ",$file,"\n";
					open (FIC, "<", $file); 
					open (SURFACETXT, ">>", "$rubrique.txt");
					open (SURFACEXML, ">>", "$rubrique.xml");
					#ramener tout le flux textuel de FIC sur une seule ligne
					my $texte="";
					while (my $ligne = <FIC>) {
					    chomp $ligne;
					    $ligne =~ s/\r//g;
					    $texte = $texte . $ligne;
			        	}
					close FIC;
					$texte =~ s/>\s+</></g;
					#on récupère le contenu des balises title et des balises description
					#dans le fichier xml, on veut les balises <item><title><description>
					while ($texte =~m/<item><title>([^<]+?)<\/title><link>(?:[^<]+?)<\/link><description>([^<]+?)<\/description>/g) {
					        my $titre = $1;
					        my $description = $2;
					        $titre=~s/&lt;.+?&gt;//g;
					        $titre.=".";
					        $titre=~s/\?\.$/\?/;
					        $description=~s/&lt;.+?&gt;//g;
					        if (!(exists $dico{$titre})) {
					            $dico{$titre} = 1;
					            print SURFACETXT "$titre\n";
					            print SURFACETXT "$description\n\n";
					            print SURFACEXML "<item><title>$titre</title><description>$description</description></item>\n";       
					        }
					}
					close SURFACETXT;
					close SURFACEXML;
		    	} #fin if rubrique.xml
            	#extraire la profondeur
		    	if ($file =~ /$rubrique.+\.txt$/) {
					open (PROFONDEUR, ">>", "$rubrique"."-profondeur.txt");
					open (PROFONDEURXML, ">>", "$rubrique"."-profondeur.xml");
					#ramener tout le flux textuel de FIC2 sur une seule ligne
					my $texte="";
					open (FIC2, "<", $file);
					while (my $ligne = <FIC2>) {
						chomp $ligne;
						$ligne =~ s/\r//g;
						$texte = $texte . $ligne;
					}
					close FIC2;
					$texte =~ s/>\s+</></g;
					# extraire le contenu textuel de l'article 
					while ($texte =~ m/<filname=\"PROF-[^>]+?>([^<]+?)</g) {
						my $article = $1;
						$article=&nettoietexte($article);
						print PROFONDEUR "$article\n\n";
						print PROFONDEURXML "<item><contenu>$article</contenu></item>\n";
					}
					close PROFONDEUR;
					close PROFONDEURXML;	
				} #fin if rubrique.txt
       		 } #fin if f file
    }#fin foreach myfile
} #fin procédure subarborescence
#----------------------------------------------

sub nettoietexte {
my $texte=shift;
	$texte =~ s/&lt;/</g;
	$texte =~ s/&gt;/>/g;
	$texte =~ s/&nbsp/ /g;
	$texte =~ s/Le Monde \|.+?[0-9]+\.[0-9]+\.[0-9]+.+?[0-9]{2}h[0-9]{2}/\n/g;
	$texte =~ s/Le.+?[0-9]+\.[0-9]+\.[0-9]+.+?[0-9]{2}h[0-9]{2}//g;
	$texte =~ s/\|//g;
	$texte =~ s/Article[^>]+la matinale du [0-9]+\/[0-9]+\/[0-9]+//g;
	$texte =~ s/D.couvrir[^>]+application//g;
	$texte =~ s/[^>]+Mis[^>]+[0-9]+h[0-9]+//g;
	$texte =~ s/data-.+?=".+?"//g;
	$texte =~ s/tabindex=".+?">//g;
	$texte =~ s/itemprop=".+?"//g;
	$texte =~ s/datetime=".+?"//g;
	$texte =~ s/Journaliste\saux?\s(Monde|desk Europe|D.codeurs)(Suivre)?//g;
	$texte =~ s/Aller\ssur\sla\spage\sde\sce\sjournaliste//g;
	$texte =~ s/Suivre\sce\sjournaliste\ssur\stwitter$//g;
	$texte =~ s/require.+twitter\/widgets.+?//g;
	$texte =~ s/Acc.dez\sau\sportfoli.*\;//g;
	$texte =~ s/Image\spr.c.dente//g;
	$texte =~ s/Image\ssuivante//g;
	$texte =~ s/Lire\sle\sdiaporama$//g;
	$texte =~ s/Mettre\sen\spauseRejouer//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/<[^>]+>//g;	
	$texte =~ s/\[[^\]]*\]//g;	
	$texte =~ s/width(=|\:)\s?".+?"//g;
	$texte =~ s/\{.*\}//g;
	$texte =~ s/lmd\.onload\(function\(\)(\{.*\])?\)\;//g;
	$texte =~ s/^function\(.*\)\{.*\}//g;
	$texte =~ s/.container.\d+//g;
	$texte =~ s/"index":[0-9]//g;
	$texte =~ s/"position":[0-9]//g;
	$texte =~ s/"total_count":[0-9]//g;
	$texte =~ s/currentIndex: [0-9]//g;
	$texte =~ s/buffer: [0-9]//g;
	$texte =~ s/height(=|\:)\s?".+?"//g;
	$texte =~ s/alt=".+?"//g;
	$texte =~ s/src=".+?"//g;
	$texte =~ s/onload=".+?"//g;
	$texte =~ s/onerror=".+?"//g;
	$texte =~ s/https?:\/\/.*\.\w{2,3}\/?.+?//g;
	$texte =~ s/var exclude = ".+?"\;//g;
	$texte =~ s/Cr.dits : .+?\/ [A-Z]{3,7}//g;
	$texte =~ s/R.agir|Classer|Email|FacebookTwitter(Google|Gmail)|\+?LinkedinPinterest\s?Partager|Partager//g;
	$texte =~ s/Abonnez\-vous.+?\spartir\sde\s\d\s.//g;
	$texte =~ s/S\'abonner\sd.s\s+?\d\s.//g;
	$texte =~ s/require\(.*\)\;//g;
	return $texte;
}