#/usr/bin/perl
<<DOC; 
////////////////////////////////////////////////////////////////////////////////////////////////////////
//                                                                                                    //
//  Nom : Hayoung SEO                                                                                 //
//  Date : Avril 2021                                                                                 //
//  Version Expression Régulère                                                                       //      
//  But : Parcourir toute l'arborescence et extraire les contenus textuels de tous les fils RSS       //
//  Entrée : 1. répertoire(racine) contenant tous les fichiers RSS                                    //
//           2. rubrique à traiter                                                                    //
//  Sortie : Un fichier au format txt + Un fichier au format XML                                      //
//  Usage : perl bao1_hayoung_seo.pl repertoire-a-parcourir rubrique                                  // 
//  Exemple d'usage : perl bao1_hayoung_seo.pl 2020 3208                                              //      
//                                                                                                    //
////////////////////////////////////////////////////////////////////////////////////////////////////////
DOC
#-----------------------------------------------------------
use strict;
use utf8;
use Timer::Simple;
my $t = Timer::Simple->new();
$t->start; # timer pour savoir le temps de traitement 
#-----------------------------------------------------------
my $rep="$ARGV[0]"; # repertoire à traiter 
my $rubrique ="$ARGV[1]"; # rubrique à traiter 

# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
# Ouverture des fichiers txt et XML 
open my $OUT,">:encoding(utf8)","bao1_sortie_$rubrique.txt";
open my $OUTXML,">:encoding(utf8)","bao1_sortiexml_$rubrique.xml";

# Ecriture de l'en-tête du fichier XML
print $OUTXML "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print $OUTXML "<corpus2020>\n";

my %dico_des_titres=();
my $compteur=0;
#----------------------------------------
# Appel du sous-programme 
&parcoursarborescencefichiers($rep);	#recurse!
#----------------------------------------
print $OUTXML "</corpus2020>\n";
# Fermeture des fichiers
close $OUT; 
close $OUTXML;
print "Temps de traitement : ", $t->elapsed, " secondes\n";
exit;
#----------------------------------------------
# Sous-programme 
sub parcoursarborescencefichiers {
    my $path = shift(@_);
    opendir(my $DIR, $path) or die "can't open $path: $!\n";
    # On lit et renvoie comme valeur la liste @files 
    my @files = readdir($DIR);
    closedir($DIR);
    # On va examiner un à un pour éviter de lire les fichiers cachés
	foreach my $file (@files) {
        # Si la condition est vrai on passe à l'itération suivante, on ne veut pas traiter 
        next if $file =~ /^\.\.?$/; # on ne lit pas les fichiers cachés (. ou .. ) sinon boucle infini 
        # S'il ne s'agit pas des fichiers cachés, on continue. On relance le parcours
        # Reécriture de localisation => on génère le nom relatif 
        $file = $path."/".$file; 
        # d : directory(repertoire)
        # S'il s'agit d'un répertoire…… 
        if (-d $file) {
            # Ce qu'on cherche n'est pas un répertoire mais un fichier donc on relance le parcours 
            # pour qu'on puisse arriver aux fichiers 
            &parcoursarborescencefichiers($file);	#recurse! 
            # Donc on va parcourir de nouveau, $path devient 2020/01 par exemple …  puis 2020/01/01… 
            # Finalement on va arriver à un fichier 
            }
        # f : file(fichier)
        # S'il s'agit d'un fichier…… 
		if (-f $file) {
            # On ne veut pas traiter les fichiers qui ne sont pas au format XML 
            # Donc l'extension doit être .xml 
			if ($file =~/$rubrique.+xml$/) {
                # Impression du traitement en cours dans la console 
				print $compteur++," Traitement de : ",$file,"\n";
                # Ouverture du fichier 
				open my $FIC,"<:encoding(utf8)",$file;
				$/=undef;   
				my $ligne=<$FIC>;
				close $FIC;
                # On va extraire les contenus textuels de titre et de description avec expression régulère
				while ($ligne=~/<item>.*?<title>(.+?)<\/title>.+?<description>(.+?)<\/description>/gs) {
					my $titre=$1; # on récupère le 1er zone de capture (1er parenthèse entre <title></title>)
					my $description=$2; # on récupère le 2eme zone de capture (2eme parenthèse)
					#$numberItem++;
                    # On évite de récuperer 2 fois la même information => utilisation de dictionnaire 
                    # Si le titre n'existe pas dans le dico_des_titres 
					if (!(exists $dico_des_titres{$titre})) { 
                        # On ajoute 
						$dico_des_titres{$titre}=$description ;
						# Appel du sous-programme de nettoyage 
						($titre,$description)=&nettoyage($titre,$description);
						# Ecriture des fichiers de sortie 
                        # 1. Fichier au format txt 
						print $OUT $titre,"\n";
						print $OUT $description,"\n";
						print $OUT "$$$\n";
                        # 2. Fichier au format XML 
						print $OUTXML "<item>\n";
						print $OUTXML "<titre>$titre</titre>\n";
						print $OUTXML "<description>$description</description>\n";
						print $OUTXML "</item>\n";
					}
				}
			}
		}
    }
}
#----------------------------------------------
# Sous-programme nettoyage 
sub nettoyage {
    # On récupère les arguments 
    my $titre = $_[0];
    my $description = $_[1];
    # Nettoyage ! 
    # On enlève <![CDATA[ et ]]>
	$titre=~s/^<!\[CDATA\[//;
	$titre=~s/\]\]>$//;
	$description=~s/^<!\[CDATA\[//;
	$description=~s/\]\]>$//;
    # On enlève ou on remplace 
    $description=~s/&lt;.+?&gt;//g; # &lt; est le code de < ,  &gt; est le code de >
    $description=~s/&#38;#39;/'/g; 
    $description=~s/&#38;#34;/"/g;
    $titre=~s/&lt;.+?&gt;//g;
    $titre=~s/&#38;#39;/'/g;
    $titre=~s/&#38;#34;/"/g;
    $titre=~s/&nbsp;/ /g;
    $description=~s/&nbsp;/ /g;
    # On ajoute un point à la fin du titre 
    # Pour la partie description il y a déjà le point à la fin => rien à faire
    $titre=~s/$/\./g;
    # S'il y a plusieur points => on ne laisse qu'un seul 
	$titre=~s/\.+$/\./g;
    return $titre,$description;
}
