﻿#!/usr/bin/perl
<<DOC; 
NOMS: TCHAPDA Princesse- RAJAONARIVELO Andria
2014-2015
 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
#-----------------------------------------------------------
#commande: perl BAO2.pl 2014
#-----------------------------------------------------------
use Encode qw (encode);
open (CHAINE, ">>ensemble_titre_description.txt");
my $rep = "$ARGV[0]";
$rep=~ s/[\/]$//;

print "Répertoire : $rep \n";
my %DICO=();

#-----------------------------------------------------------
#CLASSEMENT PAR RUBRIQUE SELON LE NOM DU FICHIER
#-----------------------------------------------------------
my %rubrique;
$rubrique{type1}= "0,2-3246,1-0,0.xml";
$rubrique{type2}= "0,2-3476,1-0,0.xml";
$rubrique{type3}= "0,2-3210,1-0,0.xml";
$rubrique{type4}= "0,2-3214,1-0,0.xml";
$rubrique{type5}= "0,2-3238,1-0,0.xml";
$rubrique{type6}= "0,2-3232,1-0,0.xml";
$rubrique{type7}= "0,2-3234,1-0,0.xml";
$rubrique{type8}= "0,2-3236,1-0,0.xml";
$rubrique{type9}= "0,2-3208,1-0,0.xml";
$rubrique{type10}= "0,2-3242,1-0,0.xml";
$rubrique{type11}= "0,2-3244,1-0,0.xml";
$rubrique{type12}= "0,2-3546,1-0,0.xml";
$rubrique{type13}= "0,2-3260,1-0,0.xml";
$rubrique{type14}= "0,2-3404,1-0,0.xml";
$rubrique{type15}= "0,57-0,64-823353,0.xml";
$rubrique{type16}= "0,2-651865,1-0,0.xml";
$rubrique{type17}= "0,2-3224,1-0,0.xml";
#-----------------------------------------------------------
#PREPARATION DU DOSSIER DE SORTIE
#-----------------------------------------------------------
system("mkdir -p RESULTAT/Sortie");
system("mkdir -p RESULTAT/Treetager");  
#-----------------------------------------------------------
#ouverture de chaque fichier selon le nom de chaque rubrique
#-----------------------------------------------------------
foreach $nom (keys(%rubrique)){
	my $output1="RESULTAT/Sortie/$nom.txt";
	open(OUT1,">","$output1");
	
	my $output2="RESULTAT/Sortie/$nom.xml";
	open(output2,">","$output2");
	print output2 "<?xml version=\"1.0\" encoding=\"iso-8859-1\" ?> \n";
	print output2 "<titre>";
    %DICO=();
    #fonction "parcoursarborescencefichiers" 
	&parcoursarborescencefichiers($rep, $nom); 
	
    print output2 "</titre>";
    close(OUT1);
    close(output2);
}
#on ouvre chaque fichier xml selon son rubrique
foreach $nom (keys(%rubrique)){
	my $untagged="RESULTAT/Sortie/".$nom.".xml";
&treetagger($untagged,$nom);
}
exit;
#-----------------------------------------------------------
# parcoursarborecencefichiers permet de parcourir la structure du fichier en balises
#-----------------------------------------------------------
sub parcoursarborescencefichiers{
	my $path=shift(@_);
	my $nomdufichier = shift(@_);
	
	opendir (DOSSIER,$path);
	my @files = readdir(DOSSIER);
	closedir(DOSSIER);
	#print "Liste des fichiers de $path: @files\n";
	foreach my $file (@files) {
		# 3 conditions :
		# Si le fichier courant est . ou .. : on le laisse tomber.
		next if $file =~ /^\.\.?$/;
		$file=$path."/".$file; 
		# Si le fichier courant est un vrai fichier et si c'est un fichier XML on le traite	
		# Il ne faut traiter que les fichiers XML.
		if ($file=~/\.xml$/) {
			if ($file=~/$rubrique{$nomdufichier}/) {
                &filtreur($file,$nomdufichier);
                #print $file,"\n";
			}
		}
		# Si le fichier courant est un rep  : on regarde son contenu.
		if (-d $file){
			&parcoursarborescencefichiers($file,$nomdufichier);
		}
	}	
}
#-----------------------------------------------------------
# filtreur permet de selectionner les parties textuelles qui nous intéressent
#-----------------------------------------------------------
sub filtreur {
    #On va chercher le texte sur lequel la fonction filtreur s'exerce et le passer en argument.
    
    my $file=shift(@_); 
	my $nom=shift(@_); 
	
    print "filtrage de $file \n";
    my $chaineconcatene="";
    open (IN,"<","$file");
    #transformation du fichier d'entrée en une seule ligne
    while (my $ligne=<IN>) {
        chomp($ligne);
        $chaineconcatene.=$ligne;
    }
    close(IN);
    $chaineconcatene=~s/> *</></g;
	while ($chaineconcatene=~m/<item>(.+?)<\/item>/g) {
        my $texte = $1;
		while ($texte=~/<title>(.+?)<\/title><link>(?:.+?)<\/link><description>(.+?)<\/description>/gm) {
			my $titre=$1;
			$titre = &nettoyage($titre);
			print CHAINE "Titre...: $titre\n";
			my $description=$2;
			$description=&nettoyage($description);
			print CHAINE "Description....: $description.$\n";
			#NOUS EVITONS LE DOUBLON DES TITRES ET DES DESCRIPTIONS, S'IL EXISTE DANS LE DICO NOUS NE TRAITONS PAS LA CHAINE, et dans le cas contraire ON LE RAJOUTE DANS LE DICO
			if (exists($DICO{$titre})){
				
			}
			else{
			#NETTOYAGE DU TEXTE
			$titre = &nettoyage($titre);
			my $titreiso=encode('iso-8859-1',$titre);
			$description=&nettoyage($description);
			my $descISO=encode('iso-8859-1', $description);
			#ON NE SELECTIONNE PAS LES PARTIES DONT LE TITRE EST VIDE
			print OUT1 " Titre: $titreiso\n" if $texte ne "";
			print output2 "<titre>$titre</titre>\n" if $texte ne "";
			print OUT1 " Description: $descISO\n" if $texte ne "";
			print output2 "<description>$description</description>\n" if $texte ne "";
		$DICO{$titre}++;
		}
	}
	}
}

#-----------------------------------------------------------
sub nettoyage {

	#remplacer &#38;#39; par ', &#38;#34; par "
	my $chainetrouvee=shift (@_); #or shift @_ #here $chainetrovee is not the same as beforehand
	$chainetrouvee =~ s/<a href[^>]+>//g;
	$chainetrouvee =~ s/&#38;#39;/'/g;
	$chainetrouvee =~ s/&#38;#34;/"/g;
	$chainetrouvee=~s/&#39;/'/g;
	$chainetrouvee=~s/&#34;/"/g;
	$chainetrouvee=~s/&#233;/é/g;
	$chainetrouvee=~s/&#234;/è/g;
	$chainetrouvee =~ s/&lt;/</g;
	$chainetrouvee =~ s/&gt;/>/g;
	$chainetrouvee =~ s/<img[^>]+>//g;
	$chainetrouvee =~ s/<\/a>//g;
	$chainetrouvee =~ s/<[^>]+>//g;
	$chainetrouvee=~s/&nbsp/ /g;
	$chainetrouvee=~s/&/and/g;
	$chainetrouvee =~ s/Le Monde.fr : .+//g;
	$chainetrouvee =~ s/Le Monde.fr//g;
	$chainetrouvee=~s/£//g;
	$chainetrouvee=~s/’/'/g;
	$chainetrouvee=~s/œ/oe/g;
	$chainetrouvee=~s/…/.../g;
	$chainetrouvee=~s/“/"/g;  
	$chainetrouvee=~s/”/"/g;
	$chainetrouvee=~s/→//g;
	$chainetrouvee=~s/–/ , /g;
	$chainetrouvee=~s/—/,/g;
	$chainetrouvee=~s/Œ/Oe/g;
	$chainetrouvee=~s/è/è/g;
	$chainetrouvee=~s/ //g;
	
	
	
	return $chainetrouvee;
	}
#-----------------------------------------------------------

#-----------------------------------------------------------
#BAO2
#-----------------------------------------------------------
sub treetagger
{
	my $text=shift(@_);
	my $rubri=shift(@_);
	system("perl5.8.9 tokenise-utf8.pl $text | tree-tagger french-utf8.par -lemma -token -no-unknown -sgml > RESULTAT/Treetager/Tagged_$rubri.txt");
	system("perl5.8.9 treetagger2xml.pl RESULTAT/Treetager/Tagged_$rubri.txt");
}
#-----------------------------------------------------------
#-----------------------------------------------------------