#!/usr/bin/perl
use XML::RSS;
use Unicode::String qw(utf8);
use Data::Dumper;

#--------------------------------------------------------------------
<<DOC; 
Votre Nom : 
    JANVIER 2005
    usage : perl parcours-arborescence-fichiers repertoire-a-parcourir
    Le programme prend en entrée le nom du répertoire contenant les fichiers
    à traiter
    Le programme construit en sortie un fichier structuré contenant sur chaque
    ligne le nom du fichier et le résultat du filtrage :
    <FICHIER><NOM>du fichier</NOM></FICHIER><CONTENU>du filtrage</CONTENU></FICHIER>
DOC
#-----------------------------------------------------------
my $rep="$ARGV[0]";
my $encodagesortie="utf-8";
# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
# on initialise une variable contenant le flux de sortie 
my %dictionnairedesitems=();
my %dictionnairesdesrubriques=();
#----------------------------------------
&parcoursarborescencefichierspourrepererlesrubriques($rep);	# on recupere les rubriques...
#----------------------------------------
my @liste_rubriques = keys(%dictionnairesdesrubriques); # préparer les antennes des fichiers xml : en-tête commune à toutes les rubriques
foreach my $rub (@liste_rubriques) {
    #print $rub,"\n";
    #----------------------------------------	
    my $output1="sortiexmlrss/SORTIE-extract-txt-".$rub.".xml";
    my $output2="sortiexmlrss/SORTIE-extract-txt-".$rub.".txt";
    if (!open (OUT1,">:encoding($encodagesortie)", $output1)) { die "Pb a l'ouverture du fichier $output1"};
    if (!open (OUT2,">:encoding($encodagesortie)",$output2)) { die "Pb a l'ouverture du fichier $output2"};
    print OUT1 "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
    print OUT1 "<arborescence>\n";
    close(OUT1);
    close(OUT2);
}
#----------------------------------------
&parcoursarborescencefichiers($rep);	#recurse!
#----------------------------------------
foreach my $rub (@liste_rubriques) {
    my $output1="sortiexmlrss/SORTIE-extract-txt-".$rub.".xml";
    if (!open (OUT1,">>:encoding($encodagesortie)", $output1)) { die "Pb a l'ouverture du fichier $output1"};
    print OUT1 "</arborescence>\n";
    #----------------------------------------------
    close(OUT1);
}
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);	#recurse!
	}
	if (-f $file) {
	    if (($file=~/\.xml$/) && ($file!~/\/fil.+\.xml$/)) {
		my $tmpXML="<file>\n";
		my $tmpTXT="";
		$tmpXML.="<name>$file</name>\n";
		#-----------------------------------------------------------
		my $file="$file";
		my $rss=new XML::RSS; #nouvel objet xml::rss vide, associé a la variable $rss
		#-----------------------------------------------------------
		eval {$rss->parsefile($file); }; 
                       #rempli mon objet rss avec la fonction parsefile, et s'assure que le fichier xml::rss sur 
                       #lequel on travaille est un doc bien formé, s'il est bien formé on inscrit l'ensemble des fichiers bien formés dans la variable rss
		if( $@ ) { # $@ variable qui contient le résultat de l'opération d'une commande (bien passé ou mal passé), valeur négative de comportement
		    $@ =~ s/at \/.*?$//s; #signale que ça s'est mal passé mais ne stoppe pas le programme           # remove module line number
		    print STDERR "\nERROR in '$file':\n $@\n";
		}
		else { #commande eval s'est bien passé, on crée la structure de données, on interroge les valeurs contenuent dans cette structure de données
		    my $date=$rss->{'channel'}->{'pubDate'};
		    my $rub=$rss->{'channel'}->{'title'};
		    print "RUBRIQUE : $rub \n";
		    my $encodage=$rss->{'encoding'};
		    $tmpXML.="<date>$date</date>\n";
		    $tmpXML.="<items>\n";
		    foreach my $item (@{$rss->{'items'}}) {
			my $titre=$item->{'title'};
			my $resume=$item->{'description'};
			$titre=&nettoietexte($titre); #& = invocation de procédure
			$resume=&nettoietexte($resume);
			if (uc($encodage) ne "UTF-8") {utf8($titre);utf8($resume);}
			$tmpTXT.="Titre : $titre \n";
			$tmpTXT.="Resume : $resume \n";;
			$tmpXML.="<item><title>$titre</title><abstract>$resume</abstract></item>\n";
		    }
		    #----------------------------------------------------------
		    $tmpXML.="</items>\n</file>\n";
		    $rub=~s/é/e/gi;
		    $rub=~s/è/e/gi;
		    $rub=~s/ê/e/gi;
		    $rub=~s/à/a/gi;
		    $rub=~ s/Le ?Monde.fr ?://;
		    $rub=~ s/ //g;
		    $rub=uc($rub);
		    #print $rub,"\n";
		    my $output1="sortiexmlrss/SORTIE-extract-txt-".$rub.".xml";
		    my $output2="sortiexmlrss/SORTIE-extract-txt-".$rub.".txt";
		    if (!open (OUT1,">>:encoding($encodagesortie)", $output1)) { die "Pb a l'ouverture du fichier $output1"};
		    if (!open (OUT2,">>:encoding($encodagesortie)",$output2)) { die "Pb a l'ouverture du fichier $output2"};
		    print OUT1 $tmpXML;
		    print OUT2 $tmpTXT;
		    close(OUT1);
		    close(OUT2);
		}
	    }
	    #----------------------------------------------------------
	}
    }
}
#--------------------------------------------------------------------------------
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;
    return $texte;
}
#-----------------------------------------------------------------------------------
sub parcoursarborescencefichierspourrepererlesrubriques {
    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) {
	    &parcoursarborescencefichierspourrepererlesrubriques($file);	#recurse!
	}
	if (-f $file) {
	    if (($file=~/\.xml$/) && ($file!~/\/fil.+\.xml$/)) {
		open(FILE,$file);
		#print "Traitement de :\n$file\n";
		my $texte="";
		while (my $ligne=<FILE>) {
		    $ligne =~ s/\n//g;
		    $texte .= $ligne;
		}
		close(FILE);
		$texte=~/encoding ?= ?[\'\"]([^\'\"]+)[\'\"]/i;
		my $encodage=$1;
		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;
		    if ($texte=~ /<channel><title>([^>]+)<\/title>/) {
			my $rub=$1;
			$rub=~s/é/e/gi;
			$rub=~s/è/e/gi;
			$rub=~s/ê/e/gi;
			$rub=~s/à/a/gi;
			$rub=~ s/Le ?Monde.fr ?://i;
			$rub=~ s/ //g;
			$rub=uc($rub);
			$dictionnairesdesrubriques{$rub}++;
		    }
		}
		else {
		    #print "$file ==> $encodage \n";
		}
	    }
	}
    }
} 

