#/usr/bin/perl
use Unicode::String qw(utf8); # on insère le module Unicode::String
use XML::RSS; # on insère le module XML::RSS
use HTML::Entities; # on insère le module HTML::Entities
use utf8; # on précise l'encodage utilisé dans le programme
use open qw/:std :utf8/; # on ouvre tous les fichiers encodés en UTF-8


<<DOC;
Loïc Dumonet - Amélie Martin - Yuan Wei :
MAI 2013
 usage : perl parcours-arborescence-fichiers1 repertoire-a-parcourir
 Le programme prend en entrée le nom du répertoire contenant les fichiers
 à traiter
 Le programme construit en sortie un fichier XML structuré les titres et descriptions issus du filtrage d'un flux RSS:
<PARCOURS><THEME theme=nom rubrique><FILTRAGE><TITRE>contenu</TITRE><DESCRIPTION>contenu</DESCRIPTION></FILTRAGE></THEME></PARCOURS>
DOC
#-----------------------------------------------------------
# on récupère le nom du dossier ou du fichier passé en argument
my $rep="$ARGV[0]";
# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
# on déclare les tableaux associatifs permettant de traiter la duplication des contenus
my %dicoDescription=();
my %dicoTitre=();
# on déclare les tableaux associatifs permettant de numéroter les ficheirs et les item traités
my %dicoTheme=();
my %dicoThemeFile=();
#----------------------------------------
# on envoie une instruction au système (unix) pour créer les dossiers où seront stockés les sorties XML et texte brut
system("mkdir bao2-rss bao2-rss/fichiers_xml bao2-rss/fichiers_txt");

#----------------------------------------
&parcoursarborescencefichiers($rep); # appel du sous-programme qui s'exécutera de façon récursive
#----------------------------------------

# on insère les balises de fermeture pour chacun des fichiers xml construits par le programme
#  on parcourt le dossier contenant les sorties XML en exécutant une commande unix dont le résultat sera rangé dans une variable
my @nom_fichier_xml=`ls bao2-rss/fichiers_xml/`;
# on récupère chaque fichier dans une liste
foreach my $xml (@nom_fichier_xml) {
    # on supprime le saut de ligne inséré automatiquement à la fin des noms de fichiers lorsqu'on exécute la commande 'ls'
    chomp $xml;
    # on ouvre chacun d'eux en concaténation pour y insérer les balises fermantes manquantes (sinon le document XML sera mal formé)
    open (THEME1, ">>:encoding(utf8)", "bao2-rss/fichiers_xml/".$xml) or die "Erreur lors de l'ouverture du fichier $xml : $!";
    print THEME1 "</THEME>\n</PARCOURS>\n";
    # on ferme les fichiers (un par un)
    close(THEME1);
}
# même manipulation avec les sorties texte brut pour fermer les fichiers ouverts créés par le programme
my @nom_fichier_txt=`ls bao2-rss/fichiers_txt/`;
foreach my $txt (@nom_fichier_txt) {
    chomp $txt;
    open (THEME2, ">>:encoding(utf8)", "bao2-rss/fichiers_txt/".$txt) or die "Erreur lors de l'ouverture du fichier $txt : $!";
    close(THEME2);
}
# on sort du programme
exit;
#----------------------------------------------
# déclaration du sous-programme 'parcoursarborescencefichiers'
sub parcoursarborescencefichiers {
    # on crée une variable qui va contenir le chemin absolu ddu dossier contenant les fichiers qui vont être traités
    my $path = shift(@_);
    # ouverture du dossier via la variable précédente
    opendir(DIR, $path) or die "can't open $path: $!\n";
    # on crée une liste qui va contenir les éléments (noms des fichiers et/ou répertoires) contenus dans ce répertoire
    my @files = readdir(DIR);
    # on ferme le répertoire exploré
    closedir(DIR);
    # pour chaque élément :
    foreach my $file (@files) {
    # (on ne prend pas en compte les éléments cachés : fichiers ou dossiers commençant par un ou deux points; on passe à l'élément suivant)
	next if $file =~ /^\.\.?$/;
	# on indique le chemin absolu du premier élément traité
	$file = $path."/".$file;
	# si l'élément est une répertoire, on recommence la procédure précédente
	if (-d $file) {
	    &parcoursarborescencefichiers($file);	#recurse!
	}
	# si c'est un fichier, on commence le traitement
	if (-f $file) {
        # on initialise une variable qui contiendra le flux de sortie xml et une autre pour les sorties en texte brut
        my $DUMPFULL1="";
        my $DUMPFULL2="";
        # on initialise une variable pour identifer le début d'un fichier (récupération du nom de la rubrique)
        my $i=1;
        my $j=1;
        # on ne traite que les fichiers XML, qui ne commencent pas par un 'f' (contenu inutile pour le traitement), et qui ne sont pas vides
        if ($file=~/^[^f]+\.xml?/ && !(-z $file)) {
        # on crée une instance du module XML::RSS
        my $rss=new XML::RSS;
        # va ouvrir le fichier, créer l'arbo et la table de hashage; codage automatiquement en UTF8
		$rss->parsefile($file);
		# on crée une liste de tables de hashage contenant elle-même une table de hashage afin de récupérer les items contenant un titre et une description
		foreach my $item (@{$rss->{'items'}}) {
			my $title=$item->{'title'};
			my $description=$item->{'description'};
			# au premier item trouvé, on récupère le nom de la rubrique en remplaçcant les éventuels espaces par des underscores
			if ($i==1) {
                    # ouverture du fichier XML
                    open (FILE, $file);
                    # on récupère l'encodage contenu dans la première ligne d'un fichier XML après l'attribut 'encoding'
                    $firstline=<FILE>;
                    if ($firstline=~/encoding=['"]([^\"']+)['"]/) {
                        # on isole l'encodage seul (sans ls guillemets)
                        $encodage=$1;
                    }
                    close(FILE);
                    # ouverture du fichier dans cet encodage pour éviter les problèmes d'affichage
                    open (FILE, "<:encoding($encodage)", $file) or die "Erreur lors de l'ouverture du fichier $file : $!";
                    # on parcourt les lignes du fichier
                    while (my $ligne=<FILE>) {
                        # si on trouve dans la ligne uen balise 'titre' avec le nom de la rubrique, on le récupère
                        if ($ligne=~/<title>(.+?) - LeMonde.fr<\/title>|<title>Le Monde.fr : (.+?)<\/title>/i) {
                            # on récupère le résultat de l'expression régulière
                            $rub=$&;
                            # on supprime tout sauf le nom de la rubrique
                            $rub=~s/<title>| |-|LeMonde\.fr<\/title>|Le|Monde\.fr : |<\/title>//gi;
                            $theme=$rub;
                            $theme_clear=$theme;
                            # on supprime les éventuels espaces
                            $theme_clear=~s/ /_/g;
                            # on unifie la rubrique économie écrite avec deux représentations différentes (initiale avec et sans accent)
                            if ($theme_clear eq "Economie") {
                                $theme_clear="Économie";
                            }
						}
                    }
                    close (FILE);
                    # si le fichier XML de la rubrique traitée existe
                    #  on ouvre le fichier XML en concaténation
                    if (-e "bao2-rss/fichiers_xml/".$theme_clear.".xml") {
                        open (THEME1, ">>:encoding(utf8)", "bao2-rss/fichiers_xml/".$theme_clear.".xml"); or die "Erreur lors de l'ouverture du fichier $theme_clear.xml : $!";
                        open (THEME2, ">>:encoding(utf8)", "bao2-rss/fichiers_txt/".$theme_clear.".txt"); or die "Erreur lors de l'ouverture du fichier $theme_clear.txt : $!";
                        $i++;
                    }
                    #  sinon on crée le fichier XML associée à cette rubrique
                    else {
                        open (THEME1, ">:encoding(utf8)", "bao2-rss/fichiers_xml/".$theme_clear.".xml"); or die "Erreur lors de l'ouverture du fichier $theme_clear.xml : $!";
                        open (THEME2, ">:encoding(utf8)", "bao2-rss/fichiers_txt/".$theme_clear.".txt"); or die "Erreur lors de l'ouverture du fichier $theme_clear.txt : $!";
                        # on inscrit dans chacun des fichiers XML et texte brut les informations suivantes (ouverture d'un document XML)
                        print THEME2 "Thème : $theme_clear. \n";
                        print THEME1 "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\" ?>\n";
                        print THEME1 "<PARCOURS>\n";
                        print THEME1 "<NOM>Loïc - Amélie - Yuan</NOM>\n";
                        print THEME1 "<THEME theme='".$theme_clear."'>\n";
                        $i++;
                    }
                }
                # on crée deux fichiers textes auxiliaires, un pour le titre et un pour la description
                open (TEMP, ">:encoding(utf8)", "templates.txt");
                open (TEMP1, ">:encoding(utf8)", "templates1.txt");
                # on numérote chaque item
                if (!exists $dicoTheme{$theme_clear}) {
                    $dicoTheme{$theme_clear}=1;
                }
                else {
                    $dicoTheme{$theme_clear}++;
                }
                # on nettoie le texte grâce au sous-programme 'entite'
                $title=&entite($title);
                # si le titre traité n'existe pas dans la table de hashage alors on le traite
                if (!exists $dicoTitre{$title}) {
                    $dicoTitre{$title}++;
                    # on inscrit le contenu du titre dans un fichier texte auxiliaire
                    print TEMP $title;
                    # le contenu de ce fichier va être étiqueter par tree tagger
                    system("perl tt/cmd/tree-tagger-french-utf8 templates.txt > templates-tt.txt");
                    # on crée une sortie XML étiquetée grâce au petit programme treetagger2xml-utf8.pl
                    system("perl tt/treetagger2xml-utf8.pl templates-tt.txt utf-8");
                    # on range dans une variable le contenu de la sortie produite
                    $title_xml=`cat templates-tt.txt.xml`;
                    $title_txt=`cat templates-tt.txt`;
                }
                # sinon pas de traitement
                else {
                    $title_xml="-";
                    $title_txt="";
                }
                # Même procédure pour la description
                $description=&entite($description);

                if (!exists $dicoDescription{$description}) {
                    $dicoDescription{$description}++;
                    print TEMP1 $description;
                    system("perl tt/cmd/tree-tagger-french-utf8 templates1.txt > templates-tt.txt");
                    system("perl tt/treetagger2xml-utf8.pl templates-tt.txt utf-8");
                    $description_xml=`cat templates-tt.txt.xml`;
                    $description_txt=`cat templates-tt.txt`;
                }
                else {
                    $description_xml="-";
                    $description_txt="";
                }
                # on sauvegarde ces résultats insérés dans un balisage XML
				$DUMPFULL1.="<item number='".$dicoTheme{$theme_clear}."'>\n<titre>".$title_xml."</titre>\n<description>\n".$description_xml."</description>\n</item>\n";
				$DUMPFULL2.=$title_txt."\n".$description_txt."\n";
				# fermeture des fichiers textes auxiliaires
				close (TEMP);
				close (TEMP1);
			}
			# on numérote le nombre de fichiers par rubrique
			if (!exists $dicoThemeFile{$theme_clear}) {
                $dicoThemeFile{$theme_clear}=1;
            }
            else {
                $dicoThemeFile{$theme_clear}++;
            }
            # on insère dans les fichiers XML et texte brut finaux ces différentes données avec le balisage XML
            print THEME1 "<FILTRAGE file='".$dicoThemeFile{$theme_clear}."' name='".$file."'>\n".$DUMPFULL1."</FILTRAGE>\n";
            print THEME2 $DUMPFULL2;
		}
    }
    # on réinitialise la variable d'identification du début de fichier
    $i=0;
    }
}
# sous-programme de nettoyage :
sub entite {
    # décodage d'entités HTML/XML via le module HTML::Entities
    my $extraction=HTML::Entities::decode(HTML::Entities::decode(shift(@_)));
    # suppression des balises inutiles ainsi que des éléments inutiles
    $extraction=~s/<p>|<\/p>|<a[^<]+>|<img[^<]+\/>|<\/a>|<!\[CDATA\[|\]\]>|<br\/>//g;
    # suppression des éventuels sauts de ligne selon le système d'exploitation utilisé
    $extraction=~s/[\xA0\xa0\x0A\x0a\x0D\x0d]//g;
    # on renvoie le titre ou la description nettoyé
    return $extraction;
}
