﻿#!/usr/bin/perl -w 
use XML::RSS; 
use Unicode::String qw(utf8);
use utf8;   
use Unicode::Normalize;
use Encode;


#---------------------------------------------------------- 
#perl parcours-filtrage-rss0804.pl 2008/
#-----------------------------------------------------------

#--------------------------------------------------------------------
my $racine=$ARGV[0];
$racine=~ s/[\/]$//;
print " Le repertoire de départ est : $racine\n";

my %dicoItems=();

my %dicoRubriques=();
&parcoursRubriques($racine);
#--------------------------------------------------------------------

my @liste_rubriques = keys(%dicoRubriques);
foreach my $rub (@liste_rubriques) {
    print "La rubrique modifiée est $rub","\n";
    #----------------------------------------
    my $output1="SORTIE-2013-rubrique/2013-extract-xml-".$rub.".xml";
    my $output2="SORTIE-2013-rubrique/2013-extract-txt-".$rub.".txt";
    my $output3="SORTIE-2013-rubrique/2013-treetagger-xml-".$rub.".xml";
    if (!open (OUT1,">:encoding(utf-8)", $output1)) { die "Pb a l'ouverture du fichier $output1"};
    if (!open (OUT2,">:encoding(iso-8859-1)",$output2)) { die "Pb a l'ouverture du fichier $output2"};
    if (!open (OUT3,">:encoding(utf-8)",$output3)) { die "Pb a l'ouverture du fichier $output3"};
    print OUT1 "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
    print OUT1 "<PARCOURS>\n";
    print OUT3 "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
    print OUT3 "<PARCOURS>\n";
    close(OUT1);
    close(OUT2);
    close(OUT3);
}



#---------------------------------------------------------------------
&recurseTousFics($racine);
#----------------------------------------------------------------------
foreach my $rub (@liste_rubriques) {
    print "La rubrique modifiée est $rub","\n";
    #----------------------------------------
    my $output1="SORTIE-2013-rubrique/2013-extract-xml-".$rub.".xml";
    #my $output2="SORTIE-2013-rubrique/2013-extract-txt-".$rub.".txt";
    my $output3="SORTIE-2013-rubrique/2013-treetagger-xml-".$rub.".xml";
    if (!open (OUT1,">>:encoding(utf-8)", $output1)) { die "Pb a l'ouverture du fichier $output1"};
   # if (!open (OUT2,">:encoding(iso-8859-1)",$output2)) { die "Pb a l'ouverture du fichier $output2"};
    if (!open (OUT3,">>:encoding(utf-8)",$output3)) { die "Pb a l'ouverture du fichier $output3"};
    print OUT1 "</PARCOURS>\n";
    print OUT3 "</PARCOURS>\n";
    close(OUT1);
    #close(OUT2);
    close(OUT3);
}
exit;
#----------------------------------------------

#---------------------------------------------------------------------------------------------------------
#--------------------------------------------------------------------------------------------------------
#------------On va appliquer les fonctionalités de la module XML::RSS dans la procedure recursive
sub recurseTousFics { 

    my $dossier=shift(@_);
    opendir(DOSSIER, $dossier) or die "can't open $dossier: $!\n";#FFFFFF
    my @files=readdir(DOSSIER);
    closedir(DOSSIER);
    print "liste des fichiers de $dossier : @files\n";
    print "Le chemin est le suivant : @files\n";
    foreach $fic (@files){
	next if $fic =~ /^\.\.?$/; #print "On ne fait rien\n";
	next if $fic =~ /\.txt$/; #print "On ne fait rien\n";
	
	$fic = $dossier."/".$fic;
	#print "FICHIER : $fic \n";

	if (-d $fic){
	    &recurseTousFics($fic);
	}
	if (-f $fic){	
		
		if (($fic=~/\.xml$/) && ($fic!~/\/fil.+\.xml$/)) {
			
		#open(FILE, $file);
		
	    print "Traitement de :\n$fic\n";
	    
#-----------Implementation du module RSS -----------------------------------------------------
	    
	    my $rss=new XML::RSS;
	    eval {$rss->parsefile($fic);}; 
	    
	    if( $@ ) { 
		#si l'opération echoue
		$@ =~ s/at \/.*?$//s; # remove module line number 
		print STDERR "\nERROR in '$fic':\n$@\n"; 
	    } 
	    # si succès 
	    else { 

		#il faut recuperer le codage de chaque fichier-----------------------------------------------
		my $encoding= $rss->{'encoding'}; 
		#print "L'encodage est $encoding\n";



		if ($encoding ne "") {
			print "Extraction dans : $fic \n";
			#open(FILE,"<:encoding($encoding)", $file);
			
			
			
			
			my $date=$rss->{'channel'}->{'pubDate'};
			
			my $rubrique=$rss->{'channel'}->{'title'};#nom de rubrique
			#print "La rubrique est $rubrique\n";
			$rubrique=~s/: *Toute *l *.*\. *//gi;#* permet de definir une lettre qui est suivie de n'importe quel caractère . et se termine par un point
			$rubrique=~ s/Le *Monde *\. *fr *: *//gi;
			$rubrique=~s/- *LeMonde *\. *fr *//gi;
			$rubrique=NFD($rubrique);# Unicode normalization Form D (NFD), canonical decomposition.
			$rubrique=~ s/ //g;
			$rubrique =~ s/[^[:ascii:]]//g; # Remove all non-ascii.
			$rubrique =~ s/ [,-] /_/g; # Replace all " - " with "_"
			$rubrique =~ s/[^A-Za-z0-9]/_/g;## Replace all non-alphanumericals with _
			#$rubrique=~ s/ //g;
			
			$rubrique=lc($rubrique);
			
			
			print "TRAITEMENT DE LA RUBRIQUE ", $rubrique, "\n";
					
#################   DEBUT EXTRACTION   #############################################
			my $tmpXML= "<file>\n";
			$tmpXML.="<name>$fic</name>\n";
			$tmpXML.="<date>$date</date>\n";
			$tmpXML.="<items>\n";
			
#__________________________________________________________________________________			
			
			
			my $tmpXMLtreetag = "<file>\n"; 
			$tmpXMLtreetag.="<name>$fic</name>\n";
			$tmpXMLtreetag.="<date>$date</date>\n";
			$tmpXMLtreetag.="<items>\n"; 
			
#__________________________________________________________________________________________________	

    my $output1="SORTIE-2013-rubrique/2013-extract-xml-".$rubrique.".xml";
    my $output2="SORTIE-2013-rubrique/2013-extract-txt-".$rubrique.".txt";
    my $output3="SORTIE-2013-rubrique/2013-treetagger-xml-".$rubrique.".xml";
    if (!open (OUT1,">>:encoding(utf-8)", $output1)) { die "Pb a l'ouverture du fichier $output1"};
    if (!open (OUT2,">>:encoding(iso-8859-1)",$output2)) { die "Pb a l'ouverture du fichier $output2"};
    if (!open (OUT3,">>:encoding(utf-8)",$output3)) { die "Pb a l'ouverture du fichier $output3"};
#__________________________________________________________________________________________________

		    my $compteurItem=0;
		    my $compteurEtiquetage=0;

		    
			foreach my $item (@{$rss->{'items'}}) { 
				my $titre=$item->{'title'}; 
				my $resume=$item->{'description'};

				if (uc($encoding) ne "UTF-8") {utf8($titre);utf8($resume)}; 
					$titre=&nettoietexte($titre); 
					$resume=&nettoietexte($resume);
					$compteurItem++; 
					
					if (!(exists($dicoItems{$resume}))) {
						$compteurEtiquetage++;
						print "Etiquetage (num : $compteurEtiquetage)  sur item (num : $compteurItem) \n";
                        my ($titreTag,$texteTag)=&treeTag($titre,$resume);
                        
                        #------conversion du texte pour le cordial en ISO----------
                       # my $titre_ISO = Encode::encode("ISO-8859-1", 
                        #$titre);
                       # my $resume_ISO = Encode::encode("ISO-8859-1", 
                       # $resume);
					   #Cela a donné les mêmes résultats et on l'a considéré redondant.
					   
						print "Insertion dans le texte\n";
                        print "Le titre est ", "$titre\n";
						print "Le resume est ", "$resume\n";
						$tmpTXT="§ $titre \n"."$resume \n";
						print OUT2 $tmpTXT;
						
						#----------------------------------------------------------
						
						$tmpXML.="<item><title>$titre</title><abstract>$resume</abstract></item>\n";
						$tmpXMLtreetag.="<item>\n<title>\n$titreTag</title>\n<abstract>\n$texteTag</abstract>\n</item>\n";
						$dicoItems{$resume}++;
					}	
	
		#else {
			#  next;
			#}
			
			
			
		    }
		    $tmpXML.="</items>\n</file>\n";
		    $tmpXMLtreetag.="</items>\n</file>\n";
		    print OUT1 $tmpXML;
		    #print OUT2 $tmpTXT;
		    print OUT3 $tmpXMLtreetag;
		    close OUT1;
		    close OUT2;
		    close OUT3;
		}
		else {
		    print "$fic ==> $encoding \n";
		}
	    }
	}
}
}
}

sub parcoursRubriques {
    my $dossier = shift(@_);
    opendir(DOSSIER, $dossier) or die "can't open $dossier: $!\n";
    my @fics = readdir(DOSSIER);
    closedir(DOSSIER);
    foreach my $fic (@fics) {
	next if $fic =~ /^\.\.?$/;
	$fic = $dossier."/".$fic;
	if (-d $fic) {
	    &parcoursRubriques($fic);	#recurse!
	}
	if (-f $fic) {
	    if (($fic=~/\.xml$/) && ($fic!~/\/fil.+\.xml$/)) {
		#open(FILE, $fic);				
#--------------------------------------------------------------------------------
		#print "Traitement de :\n$fic\n";
	    
#-----------Implementation du module RSS -----------------------------------------------------
	    
	    my $rss=new XML::RSS;
	    eval {$rss->parsefile($fic);}; 
	    
	    if( $@ ) { #si l'opération echoue
			$@ =~ s/at \/.*?$//s; # remove module line number 
		print STDERR "\nERROR in '$fic':\n$@\n"; 
	    } 
	    # si succès 
	    else { 
#--------------------------------------------------------------------------		
			print "Recherche de la rubrique dans : $fic\n";
			my $encoding=$rss->{'encoding'};
			print "Encodage : $encoding\n";
			if ($encoding ne "") {
				my $rubrique=$rss->{'channel'}->{'title'};
				#print "Rubrique trouvée : $rubrique\n";
				$rubrique=~s/: *Toute *l *.*\. *//gi;#* permet de definir une lettre qui est suivie de n'importe quel caractère . et se termine par un point
				$rubrique=~s/- *LeMonde *\. *fr *//gi;
				$rubrique=~ s/Le *Monde *\. *fr *: *//gi;
				$rubrique=~ s/Le *Monde *\. *fr * actualité* //gi;
				$rubrique=NFD($rubrique);
				$rubrique=~ s/ //g;
				$rubrique =~ s/[^[:ascii:]]//g; # Remove all non-ascii.
				$rubrique =~ s/ [-,] /_/g; # Replace all " - " with "_"
				$rubrique =~ s/[^A-Za-z0-9]/_/g;
				
				
				$rubrique=lc($rubrique);
				$dicoRubriques{$rubrique}++;		

		    }

	    }
	}
    }
}

}

#--------------------------------------------------------------------------------------------------------------------

sub treeTag{
    my ($titre,$texte)=@_;
    #----- le titre
    my $codage="utf-8";
    my $tmptag="texteTag.txt";
    my $tmptxt="treetagger.txt.xml";
    #----------------------------------------------------TITRE---------------------------------------------
    open (TMPFILE,">:encoding(utf-8)", $tmptag);
    print TMPFILE $titre,"\n";
    close(TMPFILE);
    system("perl ./treetagger/cmd/tokenise-utf8.pl $tmptag | ./treetagger/bin/tree-tagger ./treetagger/lib/french-utf8.par -lemma -token -no-unknown -sgml > treetagger.txt"); 
    system("perl ./treetagger/cmd/treetagger2xml-utf8.pl treetagger.txt $codage ");  
    # lecture du résultat étiqueté en XML :
    open(OUT,"<:encoding(utf-8)",$tmptxt);
    my $fistline=<OUT>;
    my $titreTag="";
    while (my $l=<OUT>) {
	$titreTag.=$l;
    }
    close(OUT);
    
    #------------------------------------RESUME : les formes-étiquetés du texte dans le résumé----------------------------------------
    open (TMPFILE,">:encoding(utf-8)", $tmptag);
    print TMPFILE $texte,"\n";
    close(TMPFILE);
    system("perl ./treetagger/cmd/tokenise-utf8.pl $tmptag | ./treetagger/bin/tree-tagger ./treetagger/lib/french-utf8.par -lemma -token -no-unknown -sgml > treetagger.txt");
    system("perl ./treetagger/cmd/treetagger2xml-utf8.pl treetagger.txt $codage");
    # lecture du résultat étiqueté en XML :
    open(OUT,"<:encoding(utf-8)",$tmptxt);
    my $fistline=<OUT>;
    my $texteTag="";
    while (my $l=<OUT>) {
	$texteTag.=$l;
    }
    close(OUT);
    
    #On renvoie les résultats :
    return ($titreTag,$texteTag);
}


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/<[^>]+>//g;
	$texte=~ s/&nbsp;&nbsp;//g;
	$texte =~ s/&#39;/'/g;
	$texte=~ s/&#39;&#34;/'/g;
	$texte=~s/&#34;/''/g;
	$texte=~ s/\R//;


	return $texte;
}
