#/usr/bin/perl
#-----------------------------------------------------------
# Notre script perl prend deux arguments : le nom de l'arborescence 
# 1) Le nom de l'arborescence 2021 contenant les fils RSS de l'année 2021
# 2) Le nom de la rubrique à traiter ("3208" pour la rubrique "À la une" par exemple).
# Ligne de commande : perl BAO1.pl dossier_arborescence rubrique
#-----------------------------------------------------------
use utf8;
use strict;
binmode(STDOUT, ":encoding(UTF-8)");
use File::Copy;
#-----------------------------------------------------------
# Validation des arguments donnés au programme

# On s'assure que le bon nombre d'arguments a été fourni par l'utilisateur
if ($#ARGV != 1) {
	print "Le nombre d'arguments est incorrect.\n";
	exit;
} 
#-----------------------------------------------------------
# Le programme principal

# On prend les arguments et on les stocke dans des variables associées
my $repertoire="$ARGV[0]";
my $rubrique="$ARGV[1]";
# On crée une table de hashage pour ne pas avoir de doublons
my %h_sans_doublons=();
my $nbItem=0;
# On s'assure que le nom du répertoire ne se termine pas par un 
# "/" à l'aide d'une expression régulière
$repertoire=~ s/[\/]$//;
# On ouvre deux fichiers afin d'écrire la sortie
open my $output_txt, ">:encoding(UTF-8)","perl-corpus-titre-description-$rubrique.txt";
open my $output_xml, ">:encoding(UTF-8)","perl-corpus-titre-description-$rubrique.xml";
# On print un entête xml au fichier xml
print $output_xml "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n<corpus>\n";
# On lance notre fonction "parcours_arborescence_fichiers" qui va fonctionner
# de manière récursive sur le répertoire passé en argument
&parcours_arborescence_fichiers($repertoire);	
# On ajoute la balise de fin dans le fichier xml
print $output_xml "</corpus>\n";
#print "$nbItem";
# On ferme les deux fichiers créés
close $output_txt;
close $output_xml;
# On met les fichiers de sortie dans le dossier de sortie BAO1 dédié
move("perl-corpus-titre-description-$rubrique.txt", "BAO1") or die "Erreur $!";
move("perl-corpus-titre-description-$rubrique.xml", "BAO1") or die "Erreur $!";
# On sort du programme
exit;
#-----------------------------------------------------------
# Les sous-programmes

# 1) Fonction permettant à la fois de parcourir toute l'arborescence
# et d'extraire les titres et descriptions nettoyés de chaque fichier
sub parcours_arborescence_fichiers {
	# On parcourt tous les fichiers du dossier dans l'ordre
	# en notant les chemins $path au fur et à mesure
    my $path = shift(@_);
    opendir(DIR, $path) or die "Le chemin $path n'existe pas : $!\n";
    my @files = readdir(DIR);
    closedir(DIR);
    foreach my $file (sort @files) {
		next if $file =~ /^\.\.?$/;
		$file = $path."/".$file;
		# si le fichier est un dossier, on continue à parcourir l'arborescence de manière récursive
		if (-d $file) {
			&parcours_arborescence_fichiers($file);
		}
		# si le fichier est bien un fichier RSS (xml) avec la rubrique souhaitée alors on lit le fichier
		if (-f $file) {
			if ($file =~ /$rubrique.+\.xml$/) {
				open my $input, "<:encoding(UTF-8)",$file;
				$/=undef; # par défaut cette variable contient \n
				my $ligne=<$input> ;
				close($input);
				# quand on tombe sur une ligne matchant avec cette fonction régulière
				while ($ligne=~/<item><title>(.+?)<\/title>.+?<description>(.+?)<\/description>/gs) {
					# si le titre n'est pas déjà dans la table de hashage
					# alors on écrit dans nos fichiers txt et xml
					# (on considère qu'un article est un doublon si son titre est identique)
					if (!(exists $h_sans_doublons{$1})) {
						# RQ : les tables de hashage on toujours besoin d'une valeur
						# on met ici une valeur par défaut (1)
						# on écrit le contenu nettoyé
						$h_sans_doublons{$1}=1;
						#$nbItem++;
						my $titre=&nettoyage($1);
						my $description=&nettoyage($2);
						print $output_txt "$titre \n";
						print $output_txt "$description \n";
						print $output_txt "------------------------\n";
						print $output_xml "<item>\n<titre>\n$titre\n</titre>\n<description>\n$description\n</description>\n</item>\n";	
					}
				}
			}
		}
	}
}
# 2) Fonction de nettoyage permettant de nettoyer les données
# - on nettoie notamment les CDATA présents pour des sections 
# qui ne devaient pas être reconnus comme balisage, ainsi que quelques entités XML
# - on fait en sorte d'avoir (seul) point à chaque fin de titre 
# ou de description pour faciliter l'étiquetage en BAO2
sub nettoyage {
	my $texte=shift @_;
	$texte=~s/(^<!\[CDATA\[)|(\]\]>$)//g;
	$texte=~s/&lt;.+?&gt;//g;
    $texte=~s/&#38;#39;/'/g;
    $texte=~s/&#38;#34;/"/g;
	$texte=~s/&nbsp;//g;
	$texte.=".";
	$texte=~s/\.+$/\./;
	return $texte;
}
#-----------------------------------------------------------