#!/usr/bin/perl
use warnings;
use strict;
use Unicode::String qw(utf8);
#use List::MoreUtils qw( each_array );
#########################################################################
## PROGRAMME PRINCIPAL 
#########################################################################
#on lance le programme comme ceci : perl parcours.pl 2008/

print "répertoire de départ : $ARGV[0]\n";
my $racine="$ARGV[0]";


# On crée des variables qui stocke les contenus
my $texte="";
my $encodage="";
# On déclare une variable de table vide qui stockera les noms des rubriques :
my %dicorub=();
my %dicotitre=();
my %dicodescription=();

#On parcours alors l'arborescence pour extraire les rubriques
#########################################################################
&recuprub($racine);
#########################################################################

if( %dicorub eq 0 ) { #on vérifie que la table n'est pas vide
   print "%dicorub est vide"; 
}
#print keys(%dicorub);
#on initialise une liste contenant "la liste" des rubriques qui reprend les clef de la table.
my @rubriques = keys(%dicorub);
#tout les éléments de la liste se retrouve donc être tour à tour la variable $rub
#et on crée des fichiers pour récupéré l'extraction de chacune des rubriques
print @rubriques;
foreach my $rub (@rubriques) {
		#print $rub;

		
		my $OUTTREETAG="Sortie_extraction_".$rub."-TreeTagger_.xml";
		open (OUTTREETAG,">:encoding(UTF-8)", $OUTTREETAG) or die "Pb a l'ouverture du fichier $OUTTREETAG";
		print OUTTREETAG "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
		print OUTTREETAG "<?xml-stylesheet type=\"text/xsl\" href=\"extract.xsl\"?>\n";
		print OUTTREETAG "<PARCOURS>\n";
		#close (OUTTREETAG);
				
	}
	
#print "RECUPRUB ET FICHIERS : DONE";
					
#########################################################################
&recurse($racine);
#########################################################################

my @rubriques = keys(%dicorub);
foreach my $rub (@rubriques) {
	#print $rub;

		
	my $OUTTREETAG="Sortie_extraction_".$rub."-TreeTagger_.xml";
	open (OUTTREETAG,">>:encoding(UTF-8)", $OUTTREETAG) or die "Pb a l'ouverture du fichier $OUTTREETAG";
	print OUTTREETAG "</PARCOURS>\n";
	close (OUTTREETAG);
	}

exit;




#########################################################################
## SOUS - PROGRAMMES 
#########################################################################

#########################################################################
## RECUPERATION DES NOMS DE RUBRIQUES
#########################################################################

sub recuprub {
	my $dossier=shift(@_);
	opendir(DOSSIER, $dossier) or die "can't open $dossier : $!\n";
	my @fic = readdir(DOSSIER);
	closedir(DOSSIER);
	foreach my $fic(@fic) {
		next if $fic=~/^\.\.?$/;
		my $fic=$dossier."/".$fic;
		#print $fic,"\n";	
		if (($fic eq ".") or ($fic eq "..")) {
			print "je suis sur . ou .. : je ne fais rien";	
			next
			};
			if (-d $fic) {
				my $chemin=$dossier."/".$fic;
				&recuprub($fic);
			}
			if (-f $fic) {
				#print $fic,"\n";
				my $encodage="";
				open(IN, $fic);
				my $firstline=<IN>;
				if ( $firstline =~/encoding ?= ?[\"\']+([^\"\']+)[\'\"]+/i){
					$encodage=$1;
					}
					#print $encodage;
					#close(IN);				
				if ($encodage ne "") {
					if ($fic=~/.*?.xml/){
						open (IN, "<:encoding($encodage)", $fic);    		    ## tableau des arguments entrés en ligne de commande					
							while (my $ligne=<IN>){
								#print $ligne;
									$ligne =~ s/\r/\n/g; 
									$ligne =~ s/\n//g;
									$ligne=~s/> *</></g;
									if ($ligne=~/[<channel>|<channel><atom:l..k.*?>]<title>([^<]+)<\/title>/g) {
									my $rub = nettoietexte($1);
									if (uc($encodage) ne "UTF-8") {utf8($rub);}
									#print $rub;
									###### On nettoie les noms
									$rub =~ s/é/e/gi;
									$rub =~ s/é/e/gi;
									$rub =~ s/è/e/gi;
									$rub =~ s/ê/e/gi;
									$rub =~ s/Ã /a/gi;
									$rub =~ s/à/a/gi;
									$rub =~ s/- ?L. ?MONDE.FR//gi; #jusqu'à avril
									$rub =~ s/ ?: ?toute ?l' ?actualit. ?sur ?.. ?monde.f..? ?//gi; #changement mi-avril
									$rub =~ s/L. ?Monde.fr ?://gi;
									$rub =~ s/L. ?monde.f. ?- ?actualit.//gi; #changement décembre
									$rub =~ s/ //g;
									$rub =uc($rub);  ## On les met en majuscule 
									#print $rub, "\n"; 
									$dicorub{$rub}++; ##Autovivification de la table de hachage (chaque rub est mise en clé avec une valeur de 1, évite les doublons)
									}
							}
					}
					#close(IN);	
					#print keys(%dicorub);
				}
			}
	}	
}


#########################################################################
## PARCOURS DE L'ARBORESCENCE
#########################################################################
sub recurse {

my $dossier=shift(@_);
	opendir(DOSSIER, $dossier) or die "can't open $dossier: $!\n";
	my @files = readdir(DOSSIER);
	closedir(DOSSIER);
	#print "liste de fichiers de $dossier: @files\n";
	foreach my $file(@files) {
		next if $file=~/^\.\.?$/;
		my $file=$dossier."/".$file;
		#print $file,"\n";
		if (($file eq ".") or ($file eq "..")) {
			print "je suis sur . ou .. : je ne fais rien";	
			next
			};
			if (-d $file) {
			my $chemin=$dossier."/".$file;
			&recurse($file);
			}
			if (-f $file) {
				if (($file=~/.*?.xml/) &&  ($file!~/^fil.+\.xml/)){
					print $file, "\n";
					my $encodage;
					open(IN, $file);
					my $ligne="";
					$ligne=<IN>;
					if ($ligne=~ /encoding=[\"\']+([^\"\']+)[\'\"]+/)
					{
						$encodage=$1;
						}
						print $encodage, "\n";
						#close(IN);		
						if ($encodage ne "") {
						###### Traitement des fichier xml en fonction de leur encodage :
							open (IN, "<:encoding($encodage)",$file);    			
							while (my $ligne=<IN>){
								###### On recherche la rubrique pour lui indiquer le fichier de sortie :
								$ligne =~ s/\r/\n/g; 
								$ligne =~ s/\n//g;
								$ligne=~s/> *</></g;
								if ($ligne=~/[<channel>|<channel><atom:l..k.*?>]<title>([^<]+)<\/title>/g){		
									my $rub =$1;
									$rub = &nettoietexte($1);
								if (uc($encodage) ne "UTF-8") {utf8($rub);}
									$rub =~s/é/e/gi;
									$rub =~s/é/e/gi;
									$rub =~s/è/e/gi;
									$rub =~s/ê/e/gi;
									$rub =~s/Ã /a/gi;
									$rub =~ s/à/a/gi;
									$rub =~ s/- ?L. ?MONDE.FR//gi;
									$rub =~ s/L. ?monde.f. ?- ?actualit.//gi;
									$rub =~ s/ ?: ?toute ?l' ?actualit. ?sur ?.. ?monde.f..? ?//gi;
									$rub =~ s/L. ?Monde.fr ?://gi;
									$rub =~ s/ //g;
									$rub =uc($rub);
									print $rub, "\n";
									

									my $OUTTREETAG="Sortie_extraction_".$rub."-TreeTagger_.xml";

									open (OUTTREETAG, ">>:encoding(UTF-8)", "$OUTTREETAG") or die "Erreur : impossible d'ouvrir le fichier $OUTTREETAG";

					
								while ($ligne=~/<item><title>(.*?)<\/title><l..k>.*?<\/l..k><description>(.*?)<\/description><enclosure.*?><pubDate>/g){
									my $titre=$1;
									my $description=$2;
									if (uc($encodage) ne "UTF-8") {utf8($description);utf8($titre);}
									$titre = &nettoietexte($1);
									$description = &nettoietexte($2);
									
									if (!(exists($dicodescription{$description}))){		

										my ($titreTT, $descripTT)=&etiquetagetreetagger($titre,$description);	## on ne taggue pas les doublons non plus
										print OUTTREETAG "<item>\n<titre>\n".$titreTT."<\/titre>\n<description>\n".$descripTT."<\/description>\n<\/item>\n";
										
										$dicodescription{$description}++;
									}
								}											
								}
							}

				}
			}

close (OUTTREETAG);
		}
	}
}	



#########################################################################
## NETTOYAGE DU TEXTE
#########################################################################

sub nettoietexte {
	my $text=shift;
    $text =~ s/&lt;/</g;
    $text =~ s/&gt;/>/g;
    $text =~s/<a href[^>]+>//g;
    $text =~s/<img[^>]+>//g;
    $text =~s/<\/a>//g;
    $text =~s/&#38;#39;/'/g;
    $text =~s/&#38;#34;/"/g;
    $text =~s/&#233;/é/g;
    $text =~s/&#234;/ê/g;
    $text =~s/<[^>]+>//g;
    $text =~s/&nbsp;/ /g;
    $text =~s/&amp;#38;/&/g;
    $text =~s/&amp;#39;/'/g;
    $text =~s/&amp;#34;/"/g;   
    $text =~s/http.*?html//gi;
    return $text;
	}
	
	
#########################################################################
## ETIQUETAGE AVEC TREETAGGER
#########################################################################

sub etiquetagetreetagger {

	my ($titre, $description)=(@_);
    my $tmptag="texteaetiqueter.txt";
    open (TMPFILE,">:encoding(utf-8)", $tmptag);
    print TMPFILE $titre,"\n";
    #print "TEST TT TITRE : $titre \n";
    #close(TMPFILE);
	system("perl /Applications/Treetagger/tagger-scripts/cmd/tokenize.pl $tmptag | /Applications/Treetagger/bin/tree-tagger /Applications/Treetagger/models/fr.par -lemma -token -no-unknown -sgml > treetagger.txt");
	system("perl /Applications/Treetagger/tagger-scripts/cmd/treetagger2xml.pl treetagger.txt");
    # lecture du resultat tagge en xml :
    open(OUT,"<:encoding(utf-8)","treetagger.txt.xml");
    my $fistline=<OUT>;
    my $titreTT="";
    while (my $l=<OUT>) {
	$titreTT.=$l;
    }
    #close(OUT);
    #----- le resume
    open (TMPFILE,">:encoding(utf-8)", $tmptag);
    print TMPFILE $description,"\n";
    #close(TMPFILE);
	system("perl /Applications/Treetagger/tagger-scripts/cmd/tokenize.pl $tmptag | /Applications/Treetagger/bin/tree-tagger /Applications/Treetagger/models/fr.par -lemma -token -no-unknown -sgml >  treetagger.txt");
	system("perl /Applications/Treetagger/tagger-scripts/cmd/treetagger2xml.pl treetagger.txt");

    # lecture du resultat tagge en xml :
    open(OUT,"<:encoding(utf-8)","treetagger.txt.xml");
    $fistline=<OUT>;
    my $descripTT="";
    while (my $l=<OUT>) {
	$descripTT.=$l;
    }
    close(OUT);
    # on renvoie les resultats :
    return ($titreTT, $descripTT);
}