#/usr/bin/perl
use XML::RSS;
use utf8;
use open ':utf8';
binmode(STDIN,":utf8");
binmode(STDOUT,":utf8");
#-----------------------------------------------------------
<<DOC; 
Trang LAM
 Février 2019
Bibliothèque XML::RSS
usage : perl parcours-arborescence-fichiers repertoire-a-parcourir rubrique
 Le programme prend en entrée le nom du répertoire contenant les fichiers
 à traiter et le nom de la rubrique à traiter (via une suite de chiffres)
 Le programme construit en sortie 2 fichiers :
 - un fichier TXT contient les contenus textuels des balises <titre> et <description>
 - un fichier étiqueté par TreeTagger structuré en XML 
DOC
#-----------------------------------------------------------
my $rep="$ARGV[0]";#on récupère le chemin de la racine de l'arborescence (2018)
my $rubrique="$ARGV[1]";
# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
my $i=0;
my $compteur=0; #initialiser du compteur d'item 
my %doublons;
#ouvrir les fichiers de sortie avant le parcours des fichiers 
open(OUT, ">:encoding(utf-8)", "./resultat/bao2/treetagger/bao2-$rubrique-xmlrss.txt");
open(OUTXML, ">:encoding(utf-8)", "./resultat/bao2/treetagger/bao2-$rubrique-xmlrss.xml");
print OUTXML "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
print OUTXML "<PARCOURS type=\"$rubrique\">\n"; 
print OUTXML "<NOM>Trang LAM</NOM>\n";



#----------------------------------------
&parcoursarborescencefichiers($rep);	# on lance la récursion.... et elle se terminera après examen de toute l'arborescence
close OUT;
print OUTXML "</PARCOURS>\n";
close OUTXML;
#---------------------------------------------
#---------------------------------------------------------
#pour supprimer tous les fichiers temporaires
system("unlink temp.txt");
system("unlink temp_tag.txt");
system("unlink temp_tag.txt.xml");
exit;
#----------------------------------------------
sub parcoursarborescencefichiers {
    my $path = shift(@_); #shift va supprimer le premier élément du tableau @_ (les arguments fournis) et le renvoyer. Dans notre cas, on va récupérer le nom du répertoire
    opendir(DIR, $path) or die "can't open $path: $!\n";#une fonction qui permet d'ouvrir un répertoire
    my @files = readdir(DIR);
	#readdir: lire tous les fichiers/répertoires contenus dans le répertoire prinicipal
    closedir(DIR);
 #----------------------------    
	#pour chaque fichier 
	foreach my $file (@files) {
		next if $file =~ /^\.\.?$/; #la fonction next qui nous permet d'éliminer les réperoires . et ..
		#next permet de passer au prochain élément de la liste si l'élément correspond à la regEx
		$file = $path."/".$file;#on recrée une variable 2018/Jan = la ressource file est un chemin 
		if (-d $file) { #-d= pour tester s'il sagit d'un répertoire; -d est vrai si c'est un répertoire
			print "<NOUVEAU REPERTOIRE> ==>", $file, "\n";
			#on relance le parcours du répertoire
			&parcoursarborescencefichiers($file);	
			print "<FIN REPERTOIRE> ==>",$file,"\n";
		}
		#on teste s'il s'agit d'un fichier ==> condition d'arrêt : quand on arrive sur un fichier, car on ne relance par de parcours !
		if (-f $file) {
			#si le fichier est un fichier .xml et correspond bien à la rubrique souhaitée
			if ($file=~/$rubrique.+\.xml$/) {			
				print $i++," : $file \n";
				my $rss=new XML::RSS;
				eval {$rss->parsefile($file); };
				if( $@ ) {
					$@ =~ s/at \/.*?$//s;               # remove module line number
					print STDERR "\nERROR in '$file':\n$@\n";
				} 
				else {
					foreach my $item (@{$rss->{'items'}}) {
						my $description=$item->{'description'};
						my $titre=$item->{'title'};
						$titre=~s/<[^>]+>//g;
						$description=~s/<[^>]+>//g;
						$compteur++; #compteur d'items					
						#si la clé n'existe pas on ajoute la clé et on traite le titre ==> évite les doublons !!
						my ($titrenettoye,$descriptionnettoye) = &nettoyage($titre,$description);
						if (exists $doublons{$titrenettoye}) {
							$doublons{$titrenettoye}++;
						}
						else {
							$doublons{$titrenettoye}=1;
							print OUT "TITRE : $titrenettoye\n";
							print OUT "DESCRIPTION : $descriptionnettoye\n";
							print OUTXML "<item num=\"$compteur\">\n";
							my ($titreTT,$descriptionTT) = &etiquetageTT($titrenettoye, $descriptionnettoye);
							print OUTXML "<titre>$titreTT</titre>\n";
							print OUTXML "<description>$descriptionTT</description>\n";
							print OUTXML "</item>\n";
						}
					}
				}
			}
		}
    }
}
#post traitement: nettoyage + rajout
sub nettoyage {

	my $var = $_[0]; #my ($tit, $des) = @_;
	my $var1 = $_[1];

	$var1=~s/&lt;.+?&gt;//g;#on veut supprimer les succession de balises transcodées $lt; &gt;	
	$var1=~s/&#38;#39;/'/g;#on veut également remplacer les apostrophes transcodées &#38;#39;	
	$var1=~s/&#38;#34;/"/g;#remplacement des guillemets doubles &#38;#34;
	$var1=~s/&amp;/&/g;
	$var1=~s/ //g;
	
	$var=~s/&lt;.+?&gt;//g;
	$var=~s/&#38;#39;/'/g;
	$var=~s/&#38;#34;/"/g;
	$var=~s/&amp;/&/g;
	$var=~s/ //g;
	
	 #ajouter un point au titre
	$var = $var . "." ; # $var .= ".";
	$var=~s/\.\.$/\./; #au cas où, on remplace un éventuel double . final en un seul
	return $var, $var1;
}
#-------------------------------------------------------------
sub etiquetageTT {


	my $vartitre = $_[0];
	my $vardesc = $_[1];
	my $titretagge;
	my $descriptiontagge;
	
	# créer un fichier temporaire pour stocker les titres
	open (TMP, ">:encoding(utf8)", "temp.txt");
	print TMP $vartitre ;
	close TMP;#impératif: il faut que le fichier soit fermé 
	
	
	#lancement de la commande SYSTEM qui permet de lancer une commande sur le système d'exploitation qu'on utilise
	#on applique treetagger(un programme qui fait l'étiquetage) puis treetagger2xml(un programme qui fait le balisage XML)
	system("perl tokenise-utf8.pl -f temp.txt | ./tree-tagger.exe -token -lemma -no-unknown french-utf8.par > temp_tag.txt");
	system("perl treetagger2xml-utf8.pl temp_tag.txt utf8");
	{
	local $/=undef;#cette variable permet de lire le fichier globalement (non pas par défaut ligne à ligne)
	#ouverture du fichier créé par treetagger2xml (avec des balisages XML) 
	open(FIC1, "<:encoding(utf8)", "temp_tag.txt.xml");
	$titretagge = <FIC1>;#on veut dans une variable tout le contenu du fichier. Prb: l'en-tête XML, il faut l'enlever
	close FIC1;
	$titretagge =~ s/<\?xml.+?>//;
	}
	
	#faire la même chose avec les descriptions
	open (TMP, ">:encoding(utf8)", "temp.txt");
	print TMP $vardesc ;
	close TMP;
	system("perl tokenise-utf8.pl -f temp.txt | ./tree-tagger.exe -token -lemma -no-unknown french-utf8.par > temp_tag.txt");
	system("perl treetagger2xml-utf8.pl temp_tag.txt utf8");
	{
	local $/=undef;
	open(FIC1, "<:encoding(utf8)", "temp_tag.txt.xml");
	$descriptiontagge = <FIC1>;
	$descriptiontagge =~ s/<\?xml.+?>//;
	close FIC1;
	}
	print "$titretagge\n";
	#my $rep = <STDIN>;
	return $titretagge, $descriptiontagge;
}

