#!/usr/bin/perl
use XML::RSS;
<<DOC; 
Votre Nom : 
JANVIER 2016
 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 $rubrique = "$ARGV[1]";
# on s'assure que le nom du répertoire ne se termine pas par un "/"
my %dico;
$rep=~ s/[\/]$//;# c'est 2016
# on initialise une variable contenant le flux de sortie 

#----------------------------------------PARCOURS ARBORESCENCEFICHIERS ($rep)
my $output1="$rubrique.txt";# initialisation d'une variable contenant le flux de sortie
if (!open (FILEOUT,">$output1")) { die "Pb a l'ouverture du fichier $output1"};# si le fichier ne s'ouvre  pas il s'arrête mais si non il il s'ouvre et se ferme
close(FILEOUT);

my $output2="$rubrique.xml";
if (!open (FILEOUT,">$output2")) { die "Pb a l'ouverture du fichier $output2"};
print FILEOUT "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print FILEOUT "<PARCOURS>\n";
print FILEOUT "<NOM>Emmanuelle KELODJOUE</NOM>\n";
close(FILEOUT);
#----------------------------------------
#----------------------------------------
# on appelle une procédure par le symbole "&" et on la définit à la fin // $rep est l'argument e
&parcoursarborescencefichiers($rep); #syntaxe du lancement d'un sous-programme; on lance la récursion.... et elle se terminera après examen de toute l'arborescence
#----------------------------------------
open (FILEOUT, ">>:encoding(utf-8)", $output1);
print FILEOUT "</PARCOURS>\n";
close(FILEOUT);
exit;
#----------------------------------------------
sub parcoursarborescencefichiers {
	#@_ liste d'arguements, c'est une varaible par défaut en perl 
    my $path = shift(@_);#mémorise les paramètres passés en arguments/ shift enlève le premier élément 
    # d'une liste pour le stocker
    opendir(DIR, $path) or die "can't open $path: $!\n";
    #opendir est utlisé pour ouvrir le repertoire et non les fichiers; die : on sort du programme et on renvoie un message d'erreur
    # readdir renvoie la liste des fichiers qui sont dans 2016
    my @files = readdir(DIR);
    closedir(DIR);
    #pour chaque élément de ce dossier
    foreach my $file (@files) {
	next if $file =~ /^\.\.?$/; # passe à l'élement suivant dans la liste si le fichier ets ./..

	$file = $path."/".$file; # reconstruction du chemin relatif du fichier 2016/01
	if (-d $file) { # si le fichier sur lequel je suis est un repertoire ? j'imprime le nom du reprertoire et je relance la procédure de parcours 
			print "<NOUVEAU REPERTOIRE> ==> ",$file,"\n";
			&parcoursarborescencefichiers($file);	#recurse!renommer 2016
			print "<FIN REPERTOIRE> ==> ",$file,"\n";
	}
	# Traitement de la profondeur via XML::RSS
		# -f permet de savoir si l'objet est un fichier (file) ou pas

	if (-f $file) {
		#PROFONDEUR ----------------- 
			#      Insérer ici votre code (le filtreur)#inclure notre fichier entre les deux commentaires 
			#Si c'est un fichier txt  
			# si c'est un fichier txt
		if ($file =~/$rubrique.+\.txt$/) {
				$codage = "utf-8";
				open (PROFONDEUR, ">>:encoding($codage)", "$rubrique"."profondeur.txt");
				open (PROFONDEURXML, ">>:encoding($codage)", "$rubrique"."profondeur.xml");
				
				#ramener tout le flux textuel de FIC sur une seule ligne
				my $texte="";
				
				open (FIC, "<:encoding($codage)", $file);
				
				# tant que je peux lire 1 ligne dans le fichier // lecture du fichier ligne par ligne 
				while (my $ligne = <FIC>) {
					
					# supprime le retour à ligne  
			    	chomp $ligne;
			
					# regex pour retrouver les retours à la ligne // g => global
			    	$ligne =~ s/\r//g;
			    	$texte = $texte . $ligne;
			
				}
				close FIC;
				
				# supprime les blancs => \s
				$texte =~ s/>\s+</></g;
				
				# la regex permet d'extraire le contenu textuel associé: article 
				while ($texte =~ m/<filname=\"PROF-[^>]+?>([^<]+?)</g) {
		        	my $article = $1;
					$article=~s/&lt;.+?&gt;//g;
					print PROFONDEUR "CONTENU = " . "$article\n\n";
					print PROFONDEURXML "<item nom=$file><contenu>\n"."$article\n"."</contenu></item>\n\n";
				}
				
				
				$texte=&nettoie($texte);
				close PROFONDEUR;
				close PROFONDEURXML;	
		}
			# TRAITEMENT SURFACE 
			# Si c'est un fichier xml
		if ($file =~ /$rubrique.+\.xml$/) { 
									
				print "<",$i++,"> ==> ",$file,"\n";
				# imprime le nom de fichier précédé par un compteur // permet de verifier dans la ligne de comande qu'on traite bien les bons fichiers
				$codage = "utf-8";
				#my %dico; #a délpacer en haut du programme
				#nom du fichier rss que l'on veut traiter et l'encodage
				#open (FIC, "<:encoding(utf-8)", $file); #moderne open my $in,"<",$ARGV[0];
				open (OUTTXT, ">>:encoding(utf-8)", "$rubrique.txt");
				open (OUTXML, ">>:encoding(utf-8)", "$rubrique.xml");

		# APPEL DE XML::RSS 
	 	 		my $rss=new XML::RSS;
				eval {$rss->parsefile($file); }; 
		if($@)
		{
			$@=~ s/at\/.*?$//s;		
		} 
		else 
		{
				my $date=$rss->{'channel'}->{'pubDate'};
				print OUTXML "<rss>\n";
				print OUTXML "<date>$date</date>\n";					
				foreach my $item (@{$rss->{'items'}}) 
			{
				my $titre=$item->{'title'};
				my $resume=$item->{'description'};
			if ((!(exists $dicoTitre{$titre})) and (!(exists $dicoDescription{$resume})))	
			{	
				

				# Appel fonction nettoie
				$titre=&nettoie($titre);
				$resume=&nettoie($resume);



				$dicoTitre{$titre}=1;
				$dicoDescription{$resume}=1;
				#fonction disponible avec une bibliothèque unicode::string
				#if (uc($encodage) ne "utf-8") {utf8($titre);utf8($resume);}
					print OUTTXT"Titre : $titre\n";
					print OUTTXT"Resume : $resume\n";
					print OUTXML "<item><title>$titre</title><abstract>$resume</abstract></item>\n";											
			}
		
		}
	}
print OUTXML "</rss>\n"

}	
}
				
# fermer parcours

#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-> Procédure pour nettoyer les caractères spéciaux <-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#
#suppression des éléements non pertinents 

sub nettoie
{
	my $texte=shift;
	
	$texte=~s/&lt;/</g;
	$texte=~s/&#164//g;
	$texte=~s/&#124 //g;
	$texte=~s/&gt;/>/g;
	$texte=~s/<a href[^>]+>//g;
	$texte=~s/<img[^>]+>//g;
	$texte=~s/<\/a>//g;
	$texte=~s/&#38;#34;/"/g;
	$texte=~s/<[^>]+>//g;
	$texte=~s/&#39;/'/g;
	$texte=~s/&#34;/"/g;
	$texte=~s/&nbsp;&nbsp;//g; 
	$texte=~s/&#8211;/–/g;
	$texte=~s/ & / &amp; /g;
	$texte=~s/ – / oe /g;
	$texte=~s/&#38;/&/g;
	$texte=~s/&amp;/&/g; 
	$texte=~s/&quot;/"/g; 
	$texte=~s/&apos;/'/g; 
	$texte=~s/&#60;/</g; 
	$texte=~s/</</g; 
	$texte=~s/&#62;/>/g; 
	$texte=~s/>/>/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/&uuml;/ü/g;
	$texte=~s/\x9c/œ/g; 
	$texte=~s/<br\/\>//g;
	$texte=~s/<img.*?\/>//g;
	$texte=~s/<a.*?>.*?<\/a>//g;
	$texte=~s/<![CDATA[(.*?)]]>/$1/g; 
	$texte=~ s/<[^>]>//g; 
	$texte=~s/\.$//; # protéger un caractère
	$texte=~s/ & /et/g;# s permet de substituer
	$texte=~s/<img[^>]+>//g;
	$texte=~s/<a href[^>]+>//g;
	$texte=~s/<\/a>//g;
	$texte=~s/<[^>]+>//g;
	$texte=~s/&/et/g;
	$texte=~s/\x{201c}/“/g;
	$texte=~s/\x{201d}/”/g;
	$texte=~s/\x{2019}/'/g;
	$texte=~s/\x{2018}/‘/g;
	$texte=~s/\x{2013}/-/g;
	$texte=~s/\x{2192}/→/g;
	$texte=~s/\x{2026}/.../g;
	$texte=~s/\x{0153}/Å“/g; 
	$texte=~s/\x{0152}/Å’/g;
	$texte=~s/\x{fffd}/�/g; # caractère de remplacement
	$texte=~s/\x{20ac}/€/g;
	$texte=~s/\x{2009}/ /g; # espace court



	return $texte;
	
}
#problème avec l'entête du fichier pour empêcher perl de lire la première ligne 
#reste à dupliquer pour faire la description, modfier la ligne 
#98; a cahque fois modifer le t avec le d
}
}
# programme"
#étique le tire et le renvoie
# procédure
sub etiquetage {
my ($t,$d)=@_;
#on intègre l'etiquetage
open(TMP,">:encoding(utf-8)","titre.txt");
open(TMP2,">:encoding(utf-8)","description.txt");
print TMP $t;
print TMP2 $d;
close TMP;
close TMP2;

system("perl tokenise-utf8.pl titre.txt | tree-tagger.exe -token -lemma -no-unknown french-oral-utf-8.par > titre_tag.txt"); 
system("perl tokenise-utf8.pl description.txt | tree-tagger.exe -token -lemma -no-unknown french-oral-utf-8.par > description_tag.txt");
#system permet de lancier une ligne de commande depuis le script et non le terminal
system("perl treetagger2xml-utf8.pl titre_tag.txt utf8");
system("perl treetagger2xml-utf8.pl description_tag.txt utf8");
#résultat est contenu dans titre_tag.txt 

# ouvrir fichier crée en lecture
open(TMP3, "titre_tag.txt.xml");
open(TMP4, "description_tag.txt utf8");
my $t_tag="";
my $d_tag="";
my $ligne = <TMP3>;
my $ligne = <TMP4>;
while (my$ligne = <TMP3>) {
		chomp $ligne;
		$t_tag = $t_tag . $ligne;

}
while (my$ligne = <TMP4>) {
		chomp $ligne;
		$d_tag = $d_tag . $ligne;

}
close TMP3;
close TMP4;

	return($t_tag,$d_tag);
}