#!/usr/bin/perl
# pour lancer le programme : perl bao1-script_xmlrss.pl 2013 3208 | 3214 | 2-3210 | 3232 | 3234 | 3236 | 3238 | 3242 | 3244 | 3246 | 3260 | 3404 | 3476 | 3546 | 651865 | 823353

# utilisation de la bibliothèque Perl pour traiter les fichiers XML
use XML::RSS;
# utilisation de la bibliothèque Perl pour transcoder en utf-8
use Unicode::String qw(utf8);
my $encodagesortie="utf-8";
my $rss= new XML::RSS;
my $racine=$ARGV[0];
my $namefil=$ARGV[1];
# initalisation des dictionnaires
my %dicoTitre=();
my %dicoDescription=();
&recurse($racine);# appel de la fonction

############################################################################################################
#-------------------------------------------------- PROCEDURES ------------------------------------------
############################################################################################################

####################### PARCOURS DE L'ARBORESCENCE
sub recurse {
	my $dossier=shift(@_);
	opendir(DOSSIER, $dossier);
	my @files = readdir (DOSSIER); #affiche ce qu'il y a dans un répertoire
	foreach my $file (@files){
		# si le fichier courant est . ou .., on ne s'en occupe pas :
		next if $file =~ /^\.\.?$/;
		my $file=$dossier."/".$file; # reconstruction du chemin
		if(-f $file){
			if ($file=~/$namefil.*.xml$/){
				print "Fichier en cours de traitement : $file\n";
				# verifie si le fichier xml est bien formé
				eval {$rss->parsefile($file);};
				if($@) {
					$@=~s/at \/.*?$//s;
					print STDERR "\nNe traite pas '$file':\n$@\n";
					}
				open (IN,"$file");
				# recupere la date puis la rubrique
				my $date=$rss->{'channel'}->{'pubDate'};
				my $rubrique=$rss->{'channel'}->{'title'};
				$rubrique=&nettoierubriques($rubrique);
				my $sortie="Resultat-extract-biblio_$rubrique.xml";
				# si c'est la première fois qu'on rencontre la rubrique, on crée les fichiers
				if (! -e $sortie){
					open(OUT1, ">:encoding($encodagesortie)", "Resultat-extract-biblio-UTF8_$rubrique.txt");
					open(OUT2, ">:encoding($encodagesortie)", "Resultat-extract-biblio_$rubrique.xml");
					print OUT2 "<?xml version=\"1.0\" encoding=\"$encodagesortie\" ?>\n";
					print OUT2 "<FILE>\n";
					print OUT2 "<file>\n";
					print OUT2 "<name>$file</name>\n";
					print OUT2 "<date>$date</date>\n";
					print OUT2 "<items>\n";
				}
				else{ # si les fichiers de cette rubrique existent deja, on concatene les infos
					open(OUT1, ">>:encoding($encodagesortie)", "Resultat-extract-biblio-UTF8_$rubrique.txt");
					open(OUT2, ">>:encoding($encodagesortie)", "Resultat-extract-biblio_$rubrique.xml");
					print OUT2 "<file>\n";					
					print OUT2 "<name>$file</name>\n";
					print OUT2 "<date>$date</date>\n";
					print OUT2 "<items>\n";
				}
					# on recupere les titres et les resumes
					foreach my $item (@{$rss->{'items'}}){
							my $titre=$item->{'title'};
							my $resume=$item->{'description'};
							$titre = &nettoietexte($titre);
							$resume = &nettoietexte($resume);
							# si les variables $titre et $resume ne sont pas vides...
							if (!(($titre eq "")or($resume eq ""))){
								# on evite les doublons...
								if (!((exists $dicoTitre{$rubrique.$titre}) && (exists $dicoDescription{$rubrique.$resume}))){  
									$dicoTitre{$rubrique.$titre}="1";
									$dicoDescription{$rubrique.$resume}="1";
									print OUT1 "Titre = $titre \n";
									print OUT1 "Resume = $resume \n";
									print OUT2 "<item><title>$titre</title><abstract>$resume</abstract></item>\n";
								}
							}				
					}
				print OUT2 "</items>\n</file>\n";
				}				
		} #fin du 2e if
		# si le fichier courant est un rep, on regarde son contenu :
		if (-d $file) {
			&recurse($file);
		} # fin du 3e if
	} # fin du foreach
}

print OUT2 "</FILE>\n";
close (IN);
close (OUT1);
close (OUT2);

#------------------------------------------------------------------------------------------------------------------
######################## NETTOYAGE DU TEXTE
sub nettoietexte {
	my $texte=shift; 
    $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/\.$//;
	$texte=~s/&#38;/&/g;
    $texte=~s/&amp;/&/g;
    $texte=~s/&#34;/"/g;
    $texte=~s/&quot;/"/g;
    $texte=~s/&#39;/'/g;
    $texte=~s/&apos;/'/g;
    $texte=~s/&#60;/</g;
    $texte=~s/&#62;/>/g;
    $texte=~s/&#160;//g;
    $texte=~s/&#163;/£/g;
    $texte=~s/&pound;/£/g;
    $texte=~s/&#169;/©/g;
    $texte=~s/&#171;/«/g;
    $texte=~s/&laquo;/«/g;
    $texte=~s/&#187;/»/g;
    $texte=~s/&raquo;//g;
    $texte=~s/&#201;/É/g;
    $texte=~s/&Eacute;/É/g;
    $texte=~s/&#237;/î/g;
    $texte=~s/&icirc;/î/g;
    $texte=~s/&#239;/ï/g;
    $texte=~s/&iuml;/ï/g;
    $texte=~s/&#224;/à/g;
    $texte=~s/&agrave;/à/g;
    $texte=~s/&#226;/â/g;
    $texte=~s/&acirc;/â/g;
    $texte=~s/&#231;/ç/g;
    $texte=~s/&ccedil;/ç/g;
    $texte=~s/&#232;/è/g;
    $texte=~s/&egrave;/è/g;
    $texte=~s/&#233;/é/g;
    $texte=~s/&eacute;/é/g;
    $texte=~s/&#234;/ê/g;
    $texte=~s/&ecirc;/ê/g;
    $texte=~s/&#244;/ô/g;
    $texte=~s/&ocirc;/ô/g;
    $texte=~s/&#251;/û/g;
    $texte=~s/&ucirc;/û/g;
    $texte=~s/&#252;/ü/g;
    $texte=~s/&uuml;/ü/g;
    $texte=~s/\x9c/œ/g;
    $texte=~s/&/et/g;                       
	return $texte;
}

########################## NETTOYAGE DES RUBRIQUES
sub nettoierubriques{
	my $rubrique=shift;
	$rubrique=~s/Le Monde.fr//g;
	$rubrique=~s/LeMonde.fr//g;
	$rubrique=~s/É/e/g;
	$rubrique=~s/é/e/g;
	$rubrique=~s/è/e/g;
	$rubrique=~s/ê/e/g;
	$rubrique=~s/ë/e/g;
	$rubrique=~s/ï/i/g;
	$rubrique=~s/î/i/g;
	$rubrique=~s/à/a/g;
	$rubrique=~s/ô/o/g;
	$rubrique=~s/,/_/g;	
	$rubrique=~s/Actualite//g;
	$rubrique=~s/Toute l'actualite sur //g;
	$rubrique=uc($rubrique);			
	$rubrique=~s/ //g;
	$rubrique=~s/[\.\:;\'\"\-]+//;
	return $rubrique;
}