#/usr/bin/perl
#--------------------------------------------------------------------------------------------
# --- BAO 1 --- Version: Module XML::RSS ----------------------------------------------------
#--------------------------------------------------------------------------------------------
# Entrée: le programme prend le nom du répertoire contenant les fichiers
# 		  à traiter. 
# Sortie: Le programme construit en sortie:
# 		  --> Un fichier en format du texte brut.
# 		  --> Un fichier en format structuré contenant sur chaque ligne 
#		      le nom du fichier et le résultat du filtrage.
# Mode de lancement:
# 	perl5.28.1.exe bao1_version_xmlrss.pl NOM_REPERTOIRE_A_PARCOURIR NOM_RUBRIQUE_A_EXTRAIRE
#--------------------------------------------------------------------------------------------


# Usage du module suivant:
use XML::RSS;

# Variable qui contient le dossier à  parcourir:
my $rep="$ARGV[0]";

# On s'assure que le nom du répertoire ne se termine pas par un "/":
$rep=~ s/[\/]$//;

# Numérotation des fichiers:
my $i=0;

# On crée le hash afin de supprimer les doublons:
my %doublons;

# On va créer une rubrique pour mémoriser (3208, 3210...). On y gardera l'information de la rubrique où je vais travailler:
my $rubrique = "$ARGV[1]";

# On va déclarer les fichiers de sortie:
open(OUT, ">:encoding(utf-8)", "BAO1-SORTIE-$rubrique-XMLRSS.txt"); # Variabilisation de la rubrique choisie.
open(OUTXML, ">:encoding(utf-8)", "BAO1-SORTIE-$rubrique-XMLRSS.xml");

# On écrit ici la tête pour le fichier XML:
print OUTXML "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";

print OUTXML "<premiere_boite>\n"; # Déclaration de la racine.
print OUTXML "<entete>\n";
print OUTXML "\t<bao n=\"1\">Extraction de données</bao>\n"; # Phase du traitement.

# Et les auteurs:
print OUTXML "\t<auteur id=\"LOG\">Lucía ORMAECHEA GRIJALBA</auteur>\n"; 
print OUTXML "\t<auteur id=\"VS\">Veronika SOLOPOVA</auteur>\n";

print OUTXML "</entete>\n";

print OUTXML "<fichiers rubrique=\"$rubrique\">\n"; # L'ensemble des fichiers.
#----------------------------------------------


&parcoursarborescencefichiers($rep);	# On fait appel à une fonction récursive pour parcourir l'arborescence de fichiers.

# Fermeture des fichiers:
close OUT;

print OUTXML "</fichiers>\n";
print OUTXML "</premiere_boite>\n";
close OUTXML;
exit;

#----------------------------------------------

# Définition de la fonction récursive:
sub parcoursarborescencefichiers {
	# On récupère l'ensemble de ressources dans une liste:
	my $path = shift(@_);
	
	# Fonction Perl qui me permet d'ouvrir un répertoire:
    opendir(DIR, $path) or die "Can't open $path: $!\n";
    my @files = readdir(DIR); # Fonction Perl qui me permet de lire le contenu d'un répertoire.
    closedir(DIR);
    foreach my $file (@files) {
	
		# Quand on examine une liste, 'next' me permet de passer au suivant si l'élément sur lequel on pointe vérifie l'expression régulière courante:
		next if $file =~ /^\.\.?$/; # Si on ne fait pas ça, ça va boucler sur le répertoire courant.
	
		# On récrée une variable avec le chemin où on est avec le ressource qu'on veut examiner:
		$file = $path."/".$file; # La ressource file me permet d'accéder à la ressource que je suis en train d'examiner.
	
		# On va demander si c'est un dossier ou un fichier:
		if (-d $file) { # --> Dossier
			print "\t--> On entre dans : \"$file\"\n";
			&parcoursarborescencefichiers($file);	# Fonction récursive --> Je recommence la boucle. On le fait jusqu'à épuiser toute l'arborescence.
		}
		if (-f $file) { # --> Fichier
			# On va capturer les fichiers:
			if ($file=~/$rubrique.+\.xml$/) {
			
			# Traitement à réaliser sur chaque fichier --> Filtrage:
				print $i++,": \"$file\" \n";
				print "-------------------------------------------------------\n";
				
				# Spécification du fichier:
				print OUTXML "\t<fichier n=\"$i\" chemin=\"$file\">\n";
				
				# Initialisation du compteur de 'items':
				my $n=1;
				
				# Usage du module XML::RSS:
				my $rss=new XML::RSS;
				eval {$rss->parsefile($file); }; # On parse le fichier.
				if( $@ ) {
					$@ =~ s/at \/.*?$//s; # Remove module line number
					print STDERR "\nERROR in '$file':\n$@\n";
				} 
				else {
					foreach my $item (@{$rss->{'items'}}) {
						my $titre=$item->{'title'}; # Extraction du titre.
						my $description=$item->{'description'}; # Extraction de la description.
						my $pubDate = $item->{'pubDate'}; # Extraction de la date.
						
						# Nettoyage des éléments précédents (on les garde dans une nouvelle variable):
						my ($titre_nettoye,$description_nettoyee) = &nettoyage($titre,$description);
						if (exists $doublons{$titre_nettoye}) {
							$doublons{$titre_nettoye}++;
						}
						else {
							$doublons{$titre_nettoye}=1;
							
							# Écriture des fichiers de sortie:
							#-------------- VERSION TXT----------------
							print OUT "$titre_nettoye\n";
							print OUT "$description_nettoyee\n\n";
							#------------------------------------------
							
							#-------------- VERSION XML----------------
							print OUTXML "\t\t<item n=\"$n\">\n";
							print OUTXML "\t\t\t<date>$pubDate</date>\n";
							print OUTXML "\t\t\t<titre>$titre_nettoye</titre>\n";
							print OUTXML "\t\t\t<description>$description_nettoyee</description>\n";
							print OUTXML "\t\t</item>\n";
							#------------------------------------------
							
							# Incrémentation du compteur:
							$n++;
						}
					}
				print OUTXML "\t</fichier>\n";
				}
			}
		}
    }
}

# Fonction --> Nettoyage:
sub nettoyage {
	
	# Pour accéder aux éléments: --> Une éventuelle solution:
	my $var1 = $_[0];
	my $var2 = $_[1];
	
	# Une autre solution: my($st, $d) = @_;
	# Encore une autre: my $t = shift(@_); // my $d = shift(@_);
	
	#------------------------------------
	
	# On va rajouter un point final à la fin du titre:
	$var1 = $var1 . ".";

	# On remplace par les guillemets simples:
	$var1 =~ s/&#39;/'/g;
	$var2 =~ s/&#39;/'/g;
	
	# On remplace par les guillemets doubles:
	$var1 =~ s/&#34;/\"/g;
	$var2 =~ s/&#34;/\"/g;
	
	# Squeeze des espaces:
	$var1 =~ s/    / /g;
	$var2 =~ s/    / /g;

	# On remplace les & par 'et':
	$var1 =~ s/&(amp;)?/et/g;
	$var2 =~ s/&(amp;)?/et/g;

	# Cet appel va renvoyer:	
	return $var1, $var2
}
#----------------------------------------------
#---------------FIN DU SCRIPT------------------