#!/usr/bin/perl
# pour lancer le programme : perl bao2-script_regex_treetagger.pl 2013 3208 | 3214 | 2-3210 | 3232 | 3234 | 3236 | 3238 | 3242 | 3244 | 3246 | 3260 | 3404 | 3476 | 3546 | 651865 | 823353 

# utilisation d'une bibliotheque Perl pour pouvoir transcoder en utf-8
use Unicode::String qw(utf8);
my $racine=$ARGV[0];
my $namefil=$ARGV[1];
print "repertoire de depart : $racine\n";
print "namefil : $namefil\n";
# initiatlisation des dictionnaires qui permettront d'eviter les doublons
my %dicoTitre=();
my %dicoDescription=();
# appel de la fonction qui parcours l'arborescence
&recurse($racine);

sub recurse {
	my $dossier=shift(@_);
	print "dossier = $dossier\n";
	opendir(DOSSIER, $dossier) or die "Echec de l'ouverture du dossier $dossier!\n";
	my @files = readdir (DOSSIER); #affiche ce qu'il y a dans un repertoire
	# pour chaque fichier d'un reprtoire : 
	foreach my $file (@files){
		# si le fichier courant est . ou .., on ne s'en occupe pas :
		next if $file =~ /^\.\.?$/;
		$file=$dossier."/".$file; # reconstruction du chemin
		# si c'est un repertoire, on continue le parcours sur ses fichiers...
		if (-d $file) {
			&recurse($file);
		} # fin if -d 
		# si le fichier courant est un vrai fichier et si XML, on le traite :
		if(-f $file){ # remplir ici avec le code d'extraction
		# si le fichier contient comme nom $namefil avec l'extension xml
			if ($file=~/$namefil.*.xml$/){
				print "Fichier en cours de traitement : $file\n";
				open (IN,"$file") or die "Echec de l'ouverture du fichier $file!\n";;
				# on recupere l'encodage
				my $firstLine=<IN>; 
				my $encodage=""; 
				if($firstLine=~/encoding= ?['"]([^\'"]+)['"]/) { 
						$encodage=$1; #extraire l'encodage
					print "ENCODAGE = $encodage\n";					
				}
				# on initialise la variable $texte
				my $texte="";
				# on supprime les retours a la ligne et on concatene les lignes dans la variable $texte
				while (my $ligne =<IN>) { # parcours du fichier d'entrée
					chomp $ligne;
					$texte .= $ligne;
				} # fin while ligne...	
				close (IN);	
					# on recupere le nom de la rubrique
				$texte=~/<channel><title>([^<]+)<\/title>/;
				$rubrique=&nettoierubriques($1);
				$texte=~/<pubDate>([^<]+)<\/pubDate>/;
				$date=$1;
				print "DATE = $date\n";
				print "RUBRIQUE = $rubrique\n";
				$sortie="Resultat-extract-parcours-arbo_$rubrique.xml";
				# si on a l'info sur l'encodage 
			if ($encodage ne "") {
				# si c'est la premiere fois qu'on rencontre la rubrique, on cree les fichiers...
				if (! -e $sortie){
					open(OUT1, ">:encoding(utf-8)", "Resultat-extract-parcours-arbo_$rubrique.txt");
					open(OUT2, ">:encoding(utf-8)", "Resultat-extract-parcours-arbo_$rubrique.xml");
					open(OUT3, ">:encoding(utf-8)", "Resultat-extract-parcours-arbo-treetagger_$rubrique.xml");
					print OUT2 "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\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";
					print OUT3 "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
					print OUT3 "<FILES>\n";	
					print OUT3 "<file>\n";					
					print OUT3 "<name>$file</name>\n";
					print OUT3 "<date>$date</date>\n";
					print OUT3 "<items>\n";
				} # fin if sortie...
				# sinon, on concatene les infos...
				else{
					open(OUT1, ">>:encoding(utf-8)", "Resultat-extract-parcours-arbo_$rubrique.txt");
					open(OUT2, ">>:encoding(utf-8)", "Resultat-extract-parcours-arbo_$rubrique.xml");
					open(OUT3, ">>:encoding(utf-8)", "Resultat-extract-parcours-arbo-treetagger_$rubrique.xml");
					print OUT2 "<file>\n";			
					print OUT2 "<name>$file</name>\n";
					print OUT2 "<date>$date</date>\n";
					print OUT2 "<items>\n";
					print OUT3 "<file>\n";
					print OUT3 "<name>$file</name>\n";
					print OUT3 "<date>$date</date>\n";
					print OUT3 "<items>\n";
				} # fin else sortie...
					# On récupère le titre et la description
					while ($texte=~/<item>.*?<title>([^<]*)<\/title>.+?<description>([^<]+)<\/description>/g) {
						my $titre = &nettoietexte($1);
						my $resume = &nettoietexte($2);
						#si l'encodage detexte n'est pas de l'utf-8, on transcode...
						if (uc($encodage) ne "UTF-8") {utf8($titre); utf8($resume)}
						print "TITRE = $titre\n";
						print "RESUME = $resume\n\n";
						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";
								# on appelle la fonction &treetagger pour les tagger avec treetagger...
								my ($titreetiquete)=&treetagger($titre);
								# puis on inscrit l'info dans les fichiers correspondants
								print OUT1 "Titre = $titre.\n"; # ajout d'un point pour traitement Cordial et TT
								print OUT2 "<item><title>$titre.</title>\n";
								print OUT3 "<item>\n<title>$titreetiquete</title>\n";
								print OUT1 "Resume = $resume.\n";
								print OUT2 "<abstract>$resume.</abstract></item>\n";
								print OUT3 "<abstract>$texteetiquete</abstract>\n</item>\n";
							}# fin if exists...
						} # fin if titre...
					 } # fin if texte
			} # fin if encodage...
			print OUT2 "</items>\n</file>\n";
			print OUT3 "</items>\n</file>\n";			
			} # fin if namefil...
		} # fin du 2e if file...
	} # fin du foreach
} # fin recurse...
print OUT2 "</FILE>\n";
print OUT3 "</FILES>\n";
close (OUT1);
close (OUT2);
close (OUT3);

########################## 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; # evite les noms de rubriques differents qui creeraient un autre fichier...
	$rubrique=~s/Toute l'actualite sur //g;
	$rubrique=uc($rubrique); # on met en majuscule			
	$rubrique=~s/ //g;
	$rubrique=~s/[\.\:;\'\"\-]+//;
	return $rubrique;
}

###################### UTILISATION DE TREE TAGGER
sub treetagger {
	my ($titre, $texte)=@_;
# pour le titre :
# creation fichier temporaire :
	open(fictemp, ">:encoding(UTF-8)", "fichier_temporaire.txt");
	print fictemp $titre;
	close(fictemp);
# invocation du tokaniser et de treetagger :
	system("perl tokenise-fr.pl fichier_temporaire.txt | tree-tagger.exe french-utf8.par -lemma -token -sgml > resultat-treetagger.txt");
	system("perl treetagger2xml-utf8.pl resultat-treetagger.txt utf-8");
	open(OUT, "<:encoding(utf-8)", "resultat-treetagger.txt.xml");
	my $firstline=<OUT>;
	my $titreetiquete="";
	while (my $i=<OUT>) {
		$titreetiquete.=$i;
	}
	close(OUT);
# pour le resume :
	open(fictemp, ">:encoding(UTF-8)", "fichier_temporaire.txt");
	print fictemp $texte;
	close(fictemp);
	system("perl tokenise-fr.pl fichier_temporaire.txt | tree-tagger.exe french-utf8.par -lemma -token -no-unknown -sgml > resultat-treetagger.txt");
	system("perl treetagger2xml-utf8.pl resultat-treetagger.txt utf-8");
	open(OUT, "<:encoding(utf-8)", "resultat-treetagger.txt.xml");
	my $firstline=<OUT>;
	my $texteetiquete="";
	while (my $i=<OUT>) {
		$texteetiquete.=$i;
	}
	close(OUT);
	return ($titreetiquete, $texteetiquete);
}

######################## 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;
}