#/usr/bin/perl
<<DOC;
 Auteur : Santiago HY
 Usage exemple : perl BaO-regexp.pl 2020-5j 3208
 Le programme prend comme arguments le nom du répertoire-racine contenant les fichiers
 à traiter et le nom de la rubrique à traiter parmi ces fichiers
DOC
#-----------------------------------------------------------
#$ARGV[0] = répertoire à parcourir
#$ARGV[1] = nom de la rubrique
#-----------------------------------------------------------
use XML::RSS;
use Data::Dumper;
use Data::Dump qw(dump);
use strict;
use utf8;
binmode(STDOUT,":utf8");
#-----------------------------------------------------------
# Récuperation des arguments à partir de la liste @ARGV avec laquelle le programme a été exécuté 
my $repertoire="$ARGV[0]";
my $rubrique ="$ARGV[1]";
my $rss=new XML::RSS; # Création de l'objet XML::RSS
# On évite que le chemin du répertoire finisse par "/" 
$repertoire=~ s/[\/]$//;
# Création de deux fichiers de sortie
open my $OUT ,">:encoding(utf8)","sortie-XMLRSS_$rubrique.txt";
open my $OUTXML,">:encoding(utf8)","sortie-XMLRSS_$rubrique.xml";
# Ecriture de l'entête du fichier xml
print $OUTXML "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";
print $OUTXML "<corpus2020>\n";
my %dico_titres=(); # Hash pour éviter les doublons 
# Deux variables destinées au bon affichage dans le terminal 
my $nbItem=0; 
my $i=0;
print "\n--->Extraction de la rubrique $rubrique<---\n\n";
#----------------------------------------
&parcoursarborescencefichiers($repertoire);	# Procédure récursive pour récuperer le contenu textuel 
#----------------------------------------
# Fermeture de la balise racine et des fichiers output
print $OUTXML "</corpus2020>\n";
close $OUT;
close $OUTXML;
print "Nb items traités : $nbItem \n";  
exit;
#----------------------------------------------
sub parcoursarborescencefichiers {
    # Récuperation de l'argument utilisé, càd du chemin du répertoire
	my $path = shift(@_);
	# Exploration de répertoire. L'erreur a été signalée s'il y en a une 
    opendir(my $DIRhandle, $path) or die "can't open $path: $!\n";
	# Stokage dans un liste les fichiers du répertoire
    my @files = readdir($DIRhandle);
    closedir($DIRhandle);
	# On parcours la liste de fichier en ignorant les fichiers cachés. On traite chaque fichier
	foreach my $file (sort @files) {
		# Si c'est vrai, on l'ignore
		next if $file =~ /^\.\.?$/;
		# Reconstruction du chemin
		$file = $path."/".$file;
		# Avec -d, on verifie si le fichier est un dossier. Si c'est le cas, on relance la procédure
		if (-d $file) {
			&parcoursarborescencefichiers($file);
		}
		# S'il s'agit d'un fichier, on le traite
		if (-f $file) {
			# Si c'est un fichier xml de notre rubrique ...
			if ($file =~/$rubrique.+xml$/) {
				print $i++," Traitement de : ",$file,"\n"; # Affichage du nb et du nom du fichier traité
				&traitement_XMLRSS($file) # Procédure pour traiter le fils RSS
			}
		}
    }
}
#----------------------------------------------
sub traitement_XMLRSS {
	my $file = shift(@_);
	eval {$rss->parsefile($file)};  # on remplit l'objet via parsefile sur la condition qu'il se passe bien.
	if( $@ ) {
		$@ =~ s/at \/.*?$//s;
		print STDERR "\nERROR in '$file':\n$@\n";
	}
	# S'il n'y a pas des erreurs...
	else {
		# On parcours la liste des éléments et pour chaque élément item...
		foreach my $item (@{$rss->{'items'}}) {
			# Si on ne l'ai pas traité avant (s'il n'est pas dans le dico)
			if (!(exists $dico_titres{$item->{'title'}})) {
				$dico_titres{$item->{'title'}}=$item->{'description'};
				$nbItem++;
				# On lance la procédure pour nettoyer les fils RSS
				(my $titre, my $description)=&nettoyage($item->{'title'},$item->{'description'});
				# Récuperation de la date de chaque item
				$item->{'link'} =~ m/\/(\d{4}\/\d{2}\/\d{2}).+?/;
				my $date = $1;
				# Remplissage de fichier XML. 
				print $OUT "$titre\n";
				print $OUT "$description\n";
				print $OUT "--------------------\n";
				print $OUTXML "<item date=\"$date\">\n<titre>$titre</titre>\n<description>$description</description>\n</item>\n";
			}
		}
	}
}
#----------------------------------------------
sub nettoyage {
    # Récuperation des arguments de la procédure
	# Egal à my $titre=shift(@_); my $description=shift(@_);
	# Néttoyage de contenu non textuel.
	my $titre = $_[0];
    my $description = $_[1];
	$titre=~s/^<!\[CDATA\[//;
	$titre=~s/\]\]>$//;
    $titre=~s/&lt;.+?&gt;//g;
    $titre=~s/&#38;#39;/'/g;
    $titre=~s/&#38;#34;/"/g;
    $titre=~s/$/\./g;
	$titre=~s/\.+$/\./g;
	$titre=~s/\?\.$/\?/g;
	$titre=~s/&nbsp;//g;
	$description=~s/^<!\[CDATA\[//;
	$description=~s/\]\]>$//;
	$description=~s/$/\./g;
	$description=~s/\.+$/\./g;
	$description=~s/\?\.$/\?/g;
    $description=~s/&lt;.+?&gt;//g;
    $description=~s/&#38;#39;/'/g;
    $description=~s/&#38;#34;/"/g;
	$description=~s/&nbsp;//g;
    return $titre, $description;
}