#/usr/bin/perl
#-----------------------------------------------------------
use utf8;
use strict;
binmode(STDOUT, ":encoding(UTF-8)");
#-----------------------------------------------------------

#Programme mis à jour par Myriam Dulor

# Ce programme prend en arguments 2 éléments : (1) le nom de l'arborescence 2021
# contenant les fils RSS de l'année 2021, (2) le nom de la rubrique à traiter
# ici 3210 pour l'International

#Ce programme permet de parcourir l'arborescence de fichiers du dossier 2021 (voir images sur page web BAO1), de récupérer les titres et descriptions de chaque fils d'actualité parus quotidiennement au cours de l'année 2021.
# Programme récursif : si répertoire, relance le parcours ; si fichier, réalise traitement 

#-----------------------------------------------------------
if ($#ARGV != 1) {print "Il manque un argument à votre programme....\n";exit;} # on vérifie si le(s) argument(s) existe(nt)
my $rep="$ARGV[0]"; # my = déclaration de variable en mode strict ; le nom du répertoire est passé en argument au programme : on le récupère
my $RUBRIQUE="$ARGV[1]"; # le nom de la rubrique est passé en argument au programme : on le récupère 
# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
open my $output, ">:encoding(UTF-8)","corpus-titre-description.txt"; # on formate les résultats dans le fichier de sortie "corpus-titre-description.txt", encodage universel UTF-8 
open my $output2, ">:encoding(UTF-8)","corpus-titre-description.xml"; # on formate les résultats dans le fichier de sortie "corpus-titre-description.xml", encodage universel UTF-8
print $output2 "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n<corpus>\n";
#----------------------------------------
&parcoursarborescencefichiers($rep);	#on lance le parcours récursif du répertoire c'est-à-dire de l'arbre des fils (détails plus haut)
#----------------------------------------
print $output2 "</corpus>\n";
close $output;
close $output2;
#----------------------------------------------
exit;
#----------------------------------------------

sub parcoursarborescencefichiers { # procédure du parcours
    my $path = shift(@_);
    opendir(DIR, $path) or die "can't open $path: $!\n"; # on ouvre le répertoire
    my @files = readdir(DIR); # on recupère le contenu du répertoire
    closedir(DIR);
    foreach my $file (@files) { # pour chacun des élements contenus dans le répertoire, on va vérifier son statut (répertoire ou fichier)
		next if $file =~ /^\.\.?$/; # les signes signifient ^début de chaine  .un caractère quelconque sauf fin de ligne   ? 0 ou 1 fois   $fin de chaîne
		$file = $path."/".$file; # on commence par écrire le chemin complet de l'élement
		if (-d $file) {
			print "On entre dans le REPERTOIRE : $file \n";
			&parcoursarborescencefichiers($file);	#recurse! # si l'élement est un répertoire : on relance le parcours
			print "On sort du REPERTOIRE :  $file \n";
		}
		if (-f $file) { # si l'élément est un fichier : on lance le traitement de filtrage à partir des balises title, description ...
			if ($file =~ /$RUBRIQUE.+\.xml$/) { # le signe + signifie 1 ou 0 fois ; le signe =~ veut dire "ressemble à"
				print "Traitement du fichier $file \n";
				open my $input, "<:encoding(UTF-8)",$file;
				$/=undef; # par défaut cette variable contient \n
				my $ligne=<$input> ;
				close($input);
				while ($ligne=~/<item><title>(.+?)<\/title>.+?<description>(.+?)<\/description>/gs) { # boucle, le programme passe à l'occurence suivante et ne boucle pas à #l'infini
					my $titre=&nettoyage($1);
					my $description=&nettoyage($2);
					print $output "$titre \n";
					print $output "$description \n";
					print $output "----------------------------\n";
					print $output2 "<item><titre>$titre</titre><description>$description</description></item>\n";
				}
			}
		}
    }
}
#----------------------------------------------
sub nettoyage { # cette fonction sert à nettoyer les titres et descriptions
	my $texte=shift @_;
	$texte=~s/(^<!\[CDATA\[)|(\]\]>$)//g; # CDATA = typage de données ; si je déclare CDATA, n'est pas analysé par XML
	$texte.=".";
	$texte=~s/\.+$/\./;
	return $texte;
}
#----------------------------------------------
