#/usr/bin/perl

#Le programme BAO1_extraction_rss réalise le travail demandé dans la BAO 1 à l'aide de la bibliothèque XML::RSS (https://metacpan.org/pod/XML::RSS)
#-----------------------------------------------------------------------------------------------------------------------------------------------------------
#ICI, on veut parcourir toute l'arborescence pour extraire uniquement les contenus textuels qui nous intéressent
#Ensuite, on appliquera à ces contenus un étiquetage automatique (TreeTagger/UDpipe)
#Enfin, on procèdera à des recherches et extractions syntaxiques sur ces contenus
#-----------------------------------------------------------------------------------------------------------------------------------------------------------
#Entrée : nom du répertoire contenant l'arborescence de fichiers (2020) + nom de la rubrique choisie (ex. pour la rubrique "cinéma" 3476)
#Résultat : pour une rubrique, un fichier au format txt et un fichier au format xml
#-----------------------------------------------------------------------------------------------------------------------------------------------------------
#Commande pour lancer le programme : perl BAO1__extraction_rss.pl (nom du répertoire contenant l'arborescence de fichiers) (nom de la rubrique choisie)
#Exemple : perl BAO1_extraction_rss.pl 2020 3476
#-----------------------------------------------------------------------------------------------------------------------------------------------------------

use XML::RSS;
use Data::Dumper;
use Data::Dump qw(dump);
use strict;
use utf8;
use warnings; #On précise ici qu'on veut recevoir des warnings durant l'exécution du programme si quelque choses ne se passe pas comme prévu
binmode(STDOUT,":utf8"); #Pour que tout ce qui sera affiché sur la sortie standard (écran) soit encodé en UTF-8

#On recupère dans des variables les paramètres passés par l'utilisateur en ligne de commande : nom du répertoire à parcourir et nom de la rubrique sélectionnée
#On crée un objet de type XML::RSS
my $dir="$ARGV[0]";
my $rubrique="$ARGV[1]";
my $rss=new XML::RSS;

#On vérifie que le nom du répertoire ne se termine pas par un "/" et s'il y en a un on l'élimine
$dir=~s/[\/]$//;

#On crée deux fichiers de sortie : un au format txt et un au format xml
#Pour le fichier de sortie xml, on ajoute directement l'en-tête xml et la balise racine dans laquelle sera précisé le code de la rubrique de travail
open my $output, ">:encoding(UTF-8)","2020-contenu-rss-$rubrique.txt";
open my $output2, ">:encoding(UTF-8)","2020-contenu-rss-$rubrique.xml";
print $output2 "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";
print $output2 "<corpus rubrique=\"$rubrique\">\n";

#On prépare les variables : un dictionnaire dont l'implémentation permettra d'éviter les doublons, un compteur des fichiers parcourus et un compteur du nombre d'items
my %dico_des_titres=();
my $numberItem=0;
my $nbFile=1;

#On appelle un sous-programme qui va parcourir le répertoire contenant l'arborescence des fichiers de manière récursive (A PRECISER)
#On va ainsi pouvoir voir quels éléments constituent le dossier dans lequel on se trouve (répertoire, fichier, dossier...)
&parcoursarborescencefichiers($dir);

print $output2 "</corpus>\n";
close $output;
close $output2;
print "Nb item : $numberItem \n";

#Description du sous-programme qui parcourt l'arborescence des fichiers de manière récursive
#On récupère dans une variable l'argument passé au sous-programme lors de son appel (répertoire contenant l'arborescence des fichiers - au premier appel, 2020)
#On indique à la fonction opendir()ce qu'on veut ouvrir selon deux paramètres : son descripteur dans le programme, et son nom, ici la valeur de la variable $path
#On passe le descripteur du répertoire en paramètre à readdir() pour récupérer la liste des fichiers qu'il contient 
#On passe le descripteur du répertoire en paramètre à closedir() pour le fermer
#Pour ne pas tomber dans une boucle infinie, 
#on utilise next if pour passer directement à l'itération suivante si la condition est vérifiée et on élimine le cas du répertoire courant . et du répertoire parent .. par regexp
#Condition 1 ( if (-d $file) ): $file est un répertoire, alors on relance le parcours mais au niveau du fichier courant
#Condition 2 ( if (-f $file) ): $file est un fichier 
#Attention, une fois au niveau du fichier, il faut encore filtrer : seuls les fichiers au format xml nous intéressent

sub parcoursarborescencefichiers {
    my $path = shift(@_); 
    opendir(my $DIRhandle, $path) or die "can't open $path: $!\n";
    my @files = readdir($DIRhandle);
    closedir($DIRhandle);
    foreach my $file (@files) {
        next if $file =~ /^\.\.?$/;
        $file = $path."/".$file;
        if (-d $file) { #L'élément courant n'est pas un fichier, on relance le parcours récursif
	    &parcoursarborescencefichiers($file);	
        }
        if (-f $file) { #L'élément courant est un fichier, on vérifie s'il est au format xml
        	if ($file =~/$rubrique.+\.xml$/) { #L'élément courant est un fichier xml, on procède à l'extraction des contenus textuels qui nous intéressent
        		print $nbFile++," Traitement du fichier : ",$file,"\n"; #On affiche à l'écran le numéro du fichier courant et son nom
				eval {$rss->parsefile($file); };
				if( $@ ) {
					$@ =~ s/at \/.*?$//s;
					print STDERR "\nERROR in '$file':\n$@\n";
				} 
				else {
					foreach my $item (@{$rss->{'items'}}) { #On récupère les contenus textuels titre/description uniquement
						my $titre=$item->{'title'};
						my $description=$item->{'description'};
						$numberItem++; #On incrémente le compteur du nombre d'items pour afficher le compte total à l'écran en fin de traitement 
						if (!(exists $dico_des_titres{$titre})) { #On filtre les possibles doublons en vérifiant qu'un titre n'est pas encore dans le dictionnaire pour l'implémenter
							$dico_des_titres{$titre}=$description;
							($titre,$description)=&nettoyage($titre,$description); #On appelle un sous-programme qui nettoie les contenus textuels
							#On écrit les résultats dans deux fichiers de sortie : un au format txt et un au format xml
							print $output "$titre \n";
							print $output "$description \n";
							print $output "----------------------------\n";
							print $output2 "<item>\n<titre>$titre</titre>\n<description>$description</description>\n</item>\n";
						}
					}
				}
			}
		}
	}
}

#Description du sous-programme qui nettoie les contenus textuels sélectionnés (titre et description)
#On récupère dans des variables les arguments passés au sous-programme lors de son appel (titre, description)
#On supprime les marques CDATA qui servent à signaler un contenu textuel dans un fichier xml 
#On remplace toutes les variantes de "&" par "et"
#On normalise les apostrophes
#On supprime les balises du fichier xml
#On traite les guillemets simples et doubles
#Dans le titre uniquement, on ajoute un point pour marquer la fin, et si cela entraîne un double point alors on s'assure de n'en garder qu'un seul
sub nettoyage {
	my $titre = $_[0];
    my $description = $_[1];
    $titre=~s/^<!\[CDATA\[//;
	$titre=~s/\]\]>$//;
    $titre=~s/&amp/et/g;
	$titre=~s/&amp;/et/g;
	$titre=~s/&/et/g;
	$titre=~s/’/'/g;
    $titre=~s/&lt;.+?&gt;//g;
    $titre=~s/&#38;#39;/'/g;
    $titre=~s/&#38;#34;/"/g;
    $titre=~s/$/\./g;
	$titre=~s/\.+$/\./g;
	$description=~s/^<!\[CDATA\[//;
	$description=~s/\]\]>$//;
	$description=~s/&amp/et/g;
	$description=~s/&amp;/et/g;
	$description=~s/&/et/g;
	$description=~s/’/'/g;
    $description=~s/&lt;.+?&gt;//g;
    $description=~s/&#38;#39;/'/g;
    $description=~s/&#38;#34;/"/g;
    return $titre,$description;
}

