#/usr/bin/perl

<<DOC;
Noelie BOTTERO & Yimina
Projet encadré 2 2020-2021
Pour lancer le programme : perl BAO1_XMLRSS.pl dossier-a-parcourir num-rubrique
Ce programme parcourt l'arborescence d'un flux RSS issu du site web du Monde 
afin d'en extraire le contenu textuel des balises titres et descriptions.
Le programme prend en entrée le nom du dossier-racine contenant les fichiers 
à traiter et le nom de la rubrique à traiter parmi ces fichiers.

Seconde version : XML:RSS

DOC

# -----------------------------------------------------------------

# Utilisation de la bibliothèque XML:RSS
# Le fichier perl est encodé en utf-8 ainsi que les fichiers d'entrée et de sortie

use XML::RSS; 
use utf8;
use open ':utf8';
binmode(STDIN,":utf8");
binmode(STDOUT,":utf8");

#------------------------------------------------------------------

<<DOC;
Récupération du nom du répertoire en argument, puis du numéro de la rubrique
Ouverture de deux fichiers de sortie : un en XML et l'autre en TXT
Insertion de la déclaration XML dans le fichier de sortie XML
DOC

my $rep="$ARGV[0]"; 
my $rss=new XML::RSS; 
$rep=~ s/[\/]$//; 
my $rubrique="$ARGV[1]"; 
my %dico_des_titres; 
open(OUTTXT,">:encoding(utf-8)","BAO1_XMLRSS_$rubrique.txt");
open(OUTXML,">:encoding(utf-8)","BAO1_XMLRSS_$rubrique.xml");
print OUTXML "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";

#------------------------------------------------------------------

<<DOC;
Initialisation d'un compteur d'items
Création d'une balise "corpus2020" qui contiendra comme id la valeur du nom de la rubrique
Appel de la fonction de récursivité
Fermeture de la balise extraction et des fichiers de sortie
DOC

$compteur=0;
print OUTXML "<corpus2020 type=\"$rubrique\">\n";
&parcoursarborescencefichiers($rep);
print OUTXML "</corpus2020>";
close OUTTXT; 
close OUTXML;
exit;

#------------------------------------------------------------------


# Fonction qui parcourt l'arborescence de fichiers par récursivité


sub parcoursarborescencefichiers {
    my $path = shift(@_); 	
    opendir(DIR, $path) or die "can't open $path: $!\n";
    my @files = readdir(DIR);
    closedir(DIR);

    foreach my $file (@files) {
		next if $file =~ /^\.\.?$/;
		$file = $path."/".$file; 
		if (-d $file) { 
			print "<Nouveau dossier> ==> ",$file,"\n";
			&parcoursarborescencefichiers($file); 
			print "<Fin dossier> ==> ",$file,"\n";
		}

		if (-f $file) { 
			if ($file =~/$rubrique.+xml$/){ 
				print "<",$i++,"> ==> ",$file,"\n";

				eval {$rss->parsefile($file); };
				if( $@ ) {
					$@ =~ s/at \/.*?$//s;      
					print STDERR "\nERROR in '$file':\n$@\n";
				} 
				else {
					print OUTXML "<fichier>\n";
					foreach my $item (@{$rss->{'items'}}) {
					my $description=$item->{'description'};
					my $title=$item->{'title'};
					$title=~s/<[^>]+>//g;
					$description=~s/<[^>]+>//g;
					$compteur++; 
					if (!(exists ($dico_des_titres{$title}))) {
						$dico_des_titres{$title}=1;
						my($titre_nettoye,$description_nettoye) = &nettoyage1($title,$description);
						my($titre_nettoye_XML,$description_nettoye_XML) = &nettoyage2($title,$description);
						print OUTTXT "$titre_nettoye\n$description_nettoye\n--------------------\n";
						print OUTXML "\t<item numero=\"$compteur\">\n\t\t<titre>$titre_nettoye_XML</titre>\n\t\t<description>$description_nettoye_XML</description>\n\t</item>\n";
					}
					}
					print OUTXML "</fichier>\n";
				}			
			}	
		}
	}
}

#------------------------------------------------------------------

# Procédure de nettoyage préliminaire des fichiers txt avant le traitement du contenu textuel

sub nettoyage1 { 
	my ($titre,$description)=@_;
	$description=~s/<!\[CDATA\[//;
	$description=~s/\]\]>//; 
	$description=~s/&lt;.+?&gt;//g; 
	$description=~s/&#38;#39;/'/g;
	$description=~s/&#38;#34;/"/g;
	$description=~s/&amp;/&/g; 
	$description=~s/([^\.])$/$1./g;
	$titre=~s/<!\[CDATA\[//; 
	$titre=~s/\]\]>//; 
	$titre=~s/&lt;.+?&gt;//g; 
	$titre=~s/&#38;#39;/'/g; 
	$titre=~s/&#38;#34;/"/g; 
	$titre=~s/&amp;/&/g; 
	$titre=~s/([^\.])$/$1./g; 
	return $titre,$description;
}

# Procédure de nettoyage préliminaire des fichiers xml avant le traitement du contenu textuel

sub nettoyage2 { 
	my ($titre,$description)=@_;
	$description=~s/<!\[CDATA\[//;
	$description=~s/\]\]>//; 
	$description=~s/&lt;.+?&gt;//g; 
	$description=~s/&#38;#39;/'/g; 
	$description=~s/&#38;#34;/"/g;
	$description=~s/&(?!amp;)/&amp;$1/g; 
	$description=~s/([^\.])$/$1./g;
	$titre=~s/<!\[CDATA\[//; 
	$titre=~s/\]\]>//; 
	$titre=~s/&lt;.+?&gt;//g; 
	$titre=~s/&#38;#39;/'/g; 
	$titre=~s/&#38;#34;/"/g; 
	$titre=~s/&(?!amp;)/&amp;$1/g;
	$titre=~s/([^\.])$/$1./g; 
	return $titre,$description;
}
