#!/usr/bin/perl
<<DOC;
GREZDA Bertisa 		   -- 21801648
GERVAIS d'ALDIN Thomas -- 21103028
TRIEU Thi Theu 		   -- 21703607

Avril 2021

usage: perl bào1_XMRSSpl.pl repertoire rubrique

Le programme prend en entrée le nom du répertoire contenant les fichiers et les rubriques
à traiter. 
La sortie du programme est sous forme .html et .txt

Méthode 2 : extraction du contenu textuel des balises TITLE et DESCRIPTION avec la bibliothèque XML::RSS
DOC

use XML::RSS;
use Unicode::String qw(utf8);
#----------------------------------------------
my $rep="$ARGV[0]"; #le nom du repertoire dans le quel on va chercher les fichiers a traiter passé en premier paramètre 
my $rubrique="$ARGV[1]"; # le nom de la rubrique qu'on va traiter

# On s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;

# Initialisation des fichiers TXT et XML en sortie
open(OUT,">>:encoding(utf-8)","sortie-xmlrss_$rubrique.txt"); #fichier de sortie sous le nom sortie-xmlrss_$rubrique.txt. Avec le nom de la rubrique passé en paramètre
open(OUTXML,">>:encoding(utf-8)","sortie-xmlrss_$rubrique.xml");#fichier de sortie sous le nom sortie-xmlrss_$rubrique.xml. Avec le nom de la rubrique passé en paramètre
#on referme les balises d'en tête
print OUTXML "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print OUTXML "<corpus2019>\n";
#-------------------------------------
# on lance la récursion.... et elle se terminera après examen de toute l'arborescence
&parcoursarborescencefichiers($rep); #recursivité!
#-------------------------------------
print OUTXML "</corpus2019>\n";
#on ferme nos deux fichiers de sortie 
close(OUT);
close(OUTXML);
#-------------------------------------
#une fonction qui parcours l'aboressence passé en argument
sub parcoursarborescencefichiers {
	
    my $path = shift(@_);  #vider la liste
    opendir(DIR, $path) or die "can't open $path: $!\n"; #ouvrir le repertoire dont le nom est passé en argument
    my @files = readdir(DIR); #creer une liste des noms des fichiers dans le répertoire
    closedir(DIR); #arrêter le readdir
    foreach my $file (@files) { #pour chaque fichier dans le répertoire 
	next if $file =~ /^\.\.?$/; #Pour éviter de boucler sur le même repertoire. On passe au élément suivant de la liste
	$file = $path."/".$file; #créer le chemin relatif vers le fichier. 
	if (-d $file) { #vrai si file est un repertoire
		&parcoursarborescencefichiers($file); #on reparcourt le répertorie 
	}
		if (-f $file) { #si c'est un fichier 
			    if ($file =~ m/$rubrique.+\.xml$/) {#si c'est un fichier xml 
				print $i++," Traitement de : ",$file,"\n"; #faire afficher le nom du fichier a traiter. 
				open(FIC,"<:encoding(utf8)", $file);
				my $rss=new XML::RSS;
				eval {$rss->parsefile($file); };  # évaluer la variable $rss pour trouver des erreurs 
				if( $@ ) {
					$@ =~ s/at \/.*?$//s; # remove module line number
				print STDERR "\nERROR in '$file':\n$@\n";
				}
				else {
					foreach my $item (@{$rss->{'items'}}) {
						my $titre=$item->{'title'}; #prendre le contenu de la balise description qui se trouve dans la balise item
						my $description=$item->{'description'};  #prendre le contenu de la balise description qui se trouve dans la balise item
						# Appel du sous-programme de nettoyage 
						$titre=&nettoyage($titre);
						$description=&nettoyage($description);
						# après nettoyage, on obtiendra un titre et une description propres
						if (uc($encodage) ne "UTF-8") {utf8($titre);utf8($resume);}
						# Ecriture des résultats en sorties
						print OUT $titre,"\n"; #on ecrit dans le fichier txt
						print OUT $description,"\n"; #on ecrit dans le fichier txt
						print OUT "--------------------\n";
						print OUTXML "<item>\n"; #on ecrit dans le fichier xml
						print OUTXML "<titre>$titre</titre>\n"; #on ecrit dans le fichier xml
						print OUTXML "<description>$description</description>\n"; #on ecrit dans le fichier xml
						print OUTXML "</item>\n";#on ecrit dans le fichier xml
					}
				}
			}
		}
	}
}
#----------------------------------------------------------
sub nettoyage {
	my $texte=shift;
	$texte=~s/&#39;/'/g;
	$texte=~s/&#34;/"/g;
	$texte =~ s/&lt;/</g;
	$texte =~ s/&gt;/>/g;
	$texte =~ s/&amp;/&/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/<[^>]+>//g;
	return $texte; #renvoie le text nettoyé
}
