#/usr/bin/perl

<<DOC; 
Votre Nom : Bawden, Rachel 
FEVRIER 2013
 usage : perl BAO1_PurePerl.pl repertoire-a-parcourir
 Le programme prend en entrée le nom du répertoire contenant les fichiers à traiter
 Le programme construit en sortie deux fichiers structurés par rubrique : le premier un fichier TXT contenant le contenu textuel (titre et description) de chaque item, le deuxième un fichier XML contenant (parmi d'autres informations) sur chaque ligne le nom du fichier et le résultat du filtrage :
<file>
	<name>nom du fichier</name><date>date d'édition</date>
	<item><titre>Titre de l'item<description>Description de l'élément</description></item>
	<item><titre>Titre de l'item<description>Description de l'élément</description></item>
	...
</file>
Le programme produit aussi une sortie globale, avec des items groupés par rubrique
DOC

die "Usage: $0 DossierEnEntree\n
Le programme prend en argument un dossier en entrée .\n\n" if (@ARGV < 1) || (! -e $ARGV[0]);

use Unicode::String qw(utf8);
use utf8;



#=================================================>
#					compteurs
#=================================================>
my $nbrfilesIN=0;
my $nbritemsIN=0;
my $nbritemsOUT=0;

#=================================================>
#		Initialisations et déclarations
#=================================================>

#-------------------------------------------->
#			répertoire en entrée
#-------------------------------------------->
my $rep="$ARGV[0]";
$rep=~ s/[\/]$//; # enlever le slash à la fin

#-------------------------------------------->
#			tables associatifs 
# pour vérifier la non-duplication des infos
#-------------------------------------------->
my %dicoTitre=();
my %dicoDescription=();

#-------------------------------------------->
#		Création des Dossiers de Sortie
#-------------------------------------------->
#--------------------------------->
#		Dossier Global
#--------------------------------->
my $res="../Sorties/";
if (! -e $res)
	{	
		mkdir($res) or die ("Problème avec la création du répertoire de $rep");
	}
#--------------------------------->
#		Dossier PurePerl
#--------------------------------->
$res="../Sorties/1_Sorties_PurePerl/";
if (! -e $res)
	{
		mkdir($res) or die ("Problème avec la création du répertoire de $rep");
	}					
else # si le dossier existe déjà -> vider le contenu
{

	#=================================================>
	#				Confirmation Execution
	#=================================================>
	print "Are you sure you want to execute this programme ? It will delete all files in $res ! Tapez y ou n : ";
	my $answer=<STDIN>;

	if ($answer=~/n/)
	{
		exit;
	}
	#------------ Suppression ---------->
	print ("Supprimer les fichiers existants >>");
	opendir(DIR, $res) or die "Erreur d'ouverture de repertoire: $!\n";
	my @tobedeleted = readdir(DIR);	
	foreach my $scrubbed(@tobedeleted) # pour chaque fichier dans le dossier
	{
		unlink $res.$scrubbed; # supprimer
	}
		closedir(DIR);
		print ("Done\n");	
}

#---- Sortie Globale TXT -> à concaténer au fur et à mesure ---->
open(FILEglobTXT,">:encoding(UTF-8)", $res."1_SortieGlobale.txt");

#============= Appel au sub -> parcours =========>

&parcoursarborescencefichiers($rep);	#recurse!

#================================================>

#---- fermer la sortie Globale TXT -> fini !--->
close FILEglobTXT;

#--------------Création de la Sortie Globale XML------------>
open(FILEglobXML, ">:encoding(UTF-8)", $res."1_SortieGlobale.xml");
print FILEglobXML "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print FILEglobXML "<PARCOURS>\n";
print FILEglobXML "<NOM>BAWDEN</NOM>\n";
print FILEglobXML "<FILTRAGE>";

#------------------------------------------------->
#	 Fermer les sorties XML par rubriques 
#	et écrire le contenu de la sortie globale XML
#------------------------------------------------->
opendir(DIR, $res) or die "Erreur d'ouverture du repertoire: $!\n";
my @sorties = readdir(DIR);
closedir(DIR);

foreach my $sortie (@sorties)
{
	if ($sortie=~/(.+?)\.xml$/ && $1 != "1_SortieGlobale")
	{
		my $rub=$1;
		open(FILE,">>:encoding(UTF-8)", $res.$sortie);
		print FILE "</".$rub.">\n";;
		print FILE "</PARCOURS>\n";
		close(FILE);
		
		#------ Sortie Globale Ecriture de contenu ---->
		print FILEglobXML "<$rub>\n";
		print FILEOUT "<items>";
		print FILEglobXML ${"DumpXML".$rub}; #écrire le dump global de chaque rubrique
		print FILEOUT "</items>";
		print FILEglobXML "</$rub>";
	}
} 

#-------------- Sortie Globale Fermeture------------>
print FILEglobXML "</FILTRAGE>\n";
print FILEglobXML "</PARCOURS>\n";
close(FILEglobXML);

#=================================================>
#					compteurs
#=================================================>
print "nbr files IN = $nbrfilesIN\n";
print "nbr items IN = $nbritemsIN\n";
print "nbr items OUT = $nbritemsOUT\n";

exit;

#=================================================>
#		Subroutine - Parcourir l'aborescence
#=================================================>
sub parcoursarborescencefichiers 
{
    my $path = shift(@_); # chemin vers le dossier en entrée
    opendir(DIR, $path) or die "Probleme d'ouverture du dossier: $!\n";
    my @files = readdir(DIR);
    closedir(DIR);
    
    #------traiter les fichiers un par un------>
    foreach my $file (@files) 
	{
		next if $file =~ /^\.\.?$/; # si ce n'est pas "." ou ".."
		$file = $path."/".$file;
		
		if (-d $file) # si c'est un dossier
		{
			&parcoursarborescencefichiers($file);	#recurse!
		}
		    
		if (-f $file)  #si c'est un fichier -> traitement
		{
			if ($file=~/^[^f]+?\.xml$/) #uniquement pour les fichiers XML
			{
				$nbrfilesIN++;
				print $file,"\n";
				
				open(FILE,$file);
				my $firstLine=<FILE>;
				my $encodage="";
				if($firstLine=~/encoding= ?['"]([^\'"]+)['"]/) 
				{
				    $encodage=$1; #extraire l'encodage
				}
				close(FILE);
				
				if (!($encodage eq "")) #s'il n'y a pas de déclaration d'encodage, on ne peut pas continuer
				{
					open(FILE,"<:encoding($encodage)",$file);
					my $texte="";
					
					#------------------------------------------------------->
					#				Stocker le contenu du fichier
					#		harmoniser les fichiers - sur une seule ligne
					#------------------------------------------------------->
					while (my $ligne=<FILE>) 
					{
						$ligne =~s/\n//g;
						$ligne=~s/\r//g;
						$texte .= $ligne;	
					}
					close FILE;
					$texte =~ s/> *?</></g; # coller les balises
					
					#------------------------------------------------------->
					#			Extraire les infos : rubrique, date, nom
					#------------------------------------------------------->
					$texte=~/<channel>.*?<title>(.*?)<\/title>.*?<pubDate>(.*?)<\/pubDate>.*?<\/channel>/;
					my $rubrique=&nettoyerRubriques($1); #nettoyer les rubriques
					print "RUBRIQUE : $rubrique\n";
					my $date=&nettoyerTexte($2); #extraire la date
					my $name=$file; #nom du fichier
					$name=~s/.*?(20.*)/$1/; #uniquement les fichiers XML contenant les mises à jour
					
					
					#------------------------------------------------------->
					#			Ecriture des fichiers de sortie
					# 1) ouverture des balises au début et pour chaque fichier
					#------------------------------------------------------->
					my $cheminXML=$res.$rubrique.".xml";
					if (! -e $cheminXML) #si la première fois qu'on rencontre cette rubrique
					{
						if (!open (FILEOUT,">:encoding(UTF-8)",$cheminXML)) #création du fichier
						{ 
							die "Probleme a la creation du fichier $cheminXML : $!";
						}
						#ouverture des balises XML du début du fichier
						print FILEOUT "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
						print FILEOUT "<PARCOURS>\n";
						print FILEOUT "<NOM>Bawden</NOM>\n";
						print FILEOUT "<$rubrique>\n";
						print FILEOUT "<file>";
						print FILEOUT "<name>$name</name>";
						print FILEOUT "<date>$date</date>";
						print FILEOUT "<items>";
						close(FILEOUT);
						
						${DumpXML."$rubrique"}="";
					}
					else # le fichier existe déjà
					{
						if (!open (FILEOUT,">>:encoding(UTF-8)",$cheminXML)) 
						{ 
							die "Problème a l'ouverture du fichier $cheminXML : $!";
						}
						print FILEOUT "<file>";
						print FILEOUT "<name>$name</name>";
						print FILEOUT "<date>$date</date>";
						print FILEOUT "<items>";
						close(FILEOUT);
					}

					#------------------------------------------------------->
					#			Ecriture des fichiers de sortie
					# 		2) Ecriture des titres et des descriptions
					#------------------------------------------------------->
					while ($texte=~/<item>.*?<title>(.*?)<\/title>.*?<description>(.*?)<\/description>/g) 
					{
						my $titre=$1;
						my $description=$2;
						$nbritemsIN++; #compteur
						
						
						#----------------- Nettoyage  ------------------->
						$titre=&nettoyerTexte($titre);
						$description=&nettoyerTexte($description); 
						
						
						
						if (!(($titre eq "")or($description eq "")))
						{

							#------------ Ré-encodage en UTF-8  ------------->
							if (uc($encodage) ne "UTF-8") 
							{utf8($titre);utf8($description);}
							
							#------ Test pour non-duplicaton des infos ------>
							if (!((exists $dicoTitre{$rubrique.$titre}) && (exists $dicoDescription{$rubrique.$description})))
							{
								
								$dicoTitre{$rubrique.$titre}="1";
								$dicoDescription{$rubrique.$description}="1";
								$nbritemsOUT++; #compteur
								
								#------------------------------------------------>
								#			Vers le fichier de sortie
								#------------------------------------------------>
								
								#---------------- Sorties XML ------------------->						
								if (!open (FILEOUT,">>:encoding(UTF-8)",$cheminXML)) 
								{ 
									die "Problème a l'ouverture du fichier $cheminXML";
								}
								print FILEOUT "<item>\n";
								print FILEOUT "<titre>".$titre."</titre>\n<description>".$description."</description>\n";
								print FILEOUT "</item>\n";
								close(FILEOUT);
								
								#------- Création du dumpglobal pour chaque rubrique ----->
								${"DumpXML".$rubrique}.="<item>\n<titre>".$titre."</titre>\n<description>".$description."</description>\n</item>\n";


								#---------------- Sorties TXT ------------------->
								
								my $cheminTXT=$res.$rubrique.".txt";
								if (! -e $cheminTXT) #si c'est la première fois qu'on rencontre la rubrique
								{
									if (!open (FILEOUT,">:encoding(UTF-8)",$cheminTXT)) 
									{ 
										die "Problème a l'ouverture du fichier $cheminTXT";
									}
									print FILEOUT "$titre."." $description."; #écrire directement dans le fichier de sortie
									close(FILEOUT);
									
									#------- DUMPGLOBAL ----->
									print FILEglobTXT "$titre."." $description."; #écrire directement dans le fichier de sortie
								}
								else #si la rubrique a déjà été rencontrée
								{
									if (!open (FILEOUT,">>:encoding(UTF-8)",$cheminTXT)) 
									{ 
										die "Problème a l'ouverture du fichier $cheminTXT : $!";
									}
									print FILEOUT "$titre."." $description."; #écrire directement dans le fichier de sortie
									close(FILEOUT);

									#------- DUMPGLOBAL ----->
									print FILEglobTXT "$titre."." $description."; #écrire directement dans le fichier de sortie
								}
							}
						}
					}
					#------- Fermer la balise file pour chaque fichier xml ------>
					if (!open (FILEOUT,">>:encoding(UTF-8)",$cheminXML)) 
					{ 
						die "Problème a la creation du fichier $cheminXML : $!";
					}
					print FILEOUT "</items>";
					print FILEOUT "</file>";
					close(FILEOUT);
					
				}
			}
		}
    }
}

#=================================================>
#		Subroutine - Nettoyage du texte
#=================================================>
sub nettoyerTexte
{
	my $tx=$_[0];
	
	$tx=~s/&#38;/&/g;
	$tx=~s/&amp;/&/g;
	$tx=~s/&#34;/"/g;
	$tx=~s/&quot;/"/g;
	$tx=~s/&#39;/'/g;
	$tx=~s/&apos;/'/g;
	$tx=~s/&#60;/</g;
	$tx=~s/&lt;/</g;
	$tx=~s/&#62;/>/g;
	$tx=~s/&gt;/>/g;
	$tx=~s/&#160;//g;
	$tx=~s/&nbsp;//g;
	$tx=~s/&#163;/£/g;
	$tx=~s/&pound;/£/g;
	$tx=~s/&#169;/©/g;
	$tx=~s/&#171;/«/g;
	$tx=~s/&laquo;/«/g;
	$tx=~s/&#187;/»/g;
	$tx=~s/&raquo;//g;
	$tx=~s/&#201;/É/g;
	$tx=~s/&Eacute;/É/g;
	$tx=~s/&#237;/î/g;
	$tx=~s/&icirc;/î/g;
	$tx=~s/&#239;/ï/g;
	$tx=~s/&iuml;/ï/g;
	$tx=~s/&#224;/à/g;
	$tx=~s/&agrave;/à/g;
	$tx=~s/&#226;/â/g;
	$tx=~s/&acirc;/â/g;
	$tx=~s/&#231;/ç/g;
	$tx=~s/&ccedil;/ç/g;
	$tx=~s/&#232;/è/g;
	$tx=~s/&egrave;/è/g;
	$tx=~s/&#233;/é/g;
	$tx=~s/&eacute;/é/g;
	$tx=~s/&#234;/ê/g;
	$tx=~s/&ecirc;/ê/g;
	$tx=~s/&#244;/ô/g;
	$tx=~s/&ocirc;/ô/g;
	$tx=~s/&#251;/û/g;
	$tx=~s/&ucirc;/û/g;
	$tx=~s/&#252;/ü/g;
	$tx=~s/&uuml;/ü/g;
	$tx=~s/&uuml;/ü/g;
	$tx=~s/\x9c/œ/g;
	$tx=~s/<br\/\>//g; 
	$tx=~s/<img.*?\/>//g; 
	$tx=~s/<a.*?>.*?<\/a>//g;
	$tx=~s/<![CDATA[(.*?)]]>/$1/g;
	$tx=~ s/<[^>]>//g;
	$tx=~s/\.$//;
	$tx=~s/&/et/g;
	return $tx;
}

#=================================================>
#		subroutine - Nettoyage des rubriques
#=================================================>
sub nettoyerRubriques
{
	my $rubrique=shift;
	$rubrique=~s/Le Monde.fr//g;
	$rubrique=~s/LeMonde.fr//g;
	
	$rubrique=~s/É/e/g;
	$rubrique=~s/é/e/g;
	$rubrique=~s/è/e/g;
	$rubrique=~s/ê/a/g;
	$rubrique=~s/ë/e/g;
	$rubrique=~s/ï/i/g;
	$rubrique=~s/î/i/g;
	$rubrique=~s/à/a/g;
	$rubrique=~s/ô/o/g;
	$rubrique=~s/,/_/g;
	$rubrique=uc($rubrique);
	$rubrique=~s/ //g;
	$rubrique=~s/[\.\:;\'\"\-]+//g;
	return $rubrique;
}
#----------------------------------------------
