﻿#/usr/bin/perl
#On va utilitser une bibliotheque unicode string avec la fonction utf-8. qw: quote word, il extrait l'argument entre parenthese de la chaine
use Unicode::String qw(utf8);

<<DOC; 
Votre Nom : Thomas MORLAINE, Francesca ERVAS, Ardas KHALSA 
FEVRIER 2012
BAO1
usage : perl scriptarborescence.pl 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 structuré contenant sur chaque
ligne le nom du fichier et le résultat du filtrage :
<FICHIER><NOM>du fichier</NOM></FICHIER><CONTENU>du filtrage</CONTENU></FICHIER>
DOC

#----------------------------------------------------------------------------------------------------------
#                         L'ENCODAGE
#----------------------------------------------------------------------------------------------------------

#Definition de variable de quelle sorte qu'elle contient l'information "utf-8" 
my $encodagesortie="utf-8"; 

#On va recuperer l'encodage dans chaque fichier RSS
my $encodage=`file -I $ARGV[0] | cut -d= -f2`; 
print "ENCODAGE : $encodage\n"; 

#Une commande qui travaille sur les chaines de caracteres, supprime les eventuels retour a la ligne, on cree une ligne
chomp($encodage); 

#On ouvre un fichier en lecture en specifiant l'encodage du fichier
open(FILE,"<:encoding ($encodage)", $ARGV[0]); 

#On ouvre des fichiers de sorties et les stocker dans deux fichiers, on force l'encodage de sortie (utf-8)
open(OUT1,">:encoding($encodagesortie)","SORTIE.txt"); 
open(OUT2,">:encoding($encodagesortie)","SORTIE.xml"); 

print OUT2 "<?xml version=\"1.0\" encoding=\"$encodagesortie\" ?>\n"; 
print OUT2 "<file>\n"; 
print OUT2 "<name>$ARGV[0]</name>\n"; 

#----------------------------------------------------------------------------------------------------------
#On fait un pre-traitement quelque soit le fichier d'entree de tel sorte que le contenu textuel soit sur une SEULE ligne pr avoir un format unique pour ensuite faire un traitement generique
#----------------------------------------------------------------------------------------------------------

#On cree un variable ou il n'y a rien
my $texte=""; 

#On parcourt les fichiers ouverts en lecture ligne a ligne
while (my $ligne=<FILE>) { 
 
 #On supprime les retour a la ligne, on aurait pu utiliser chomp au lieu de s, ou $/ 
 $ligne =~ s/\n//g; 
 
 #On concatene chaque nouvelle ligne dans $texte
 $texte .= $ligne; 
} 

#Nettoyage: on supprime les blancs potentiels entre les balises dans les lignes stockes dans la variable $texte
$texte =~ s/> *</></g; 

#On recupere la date du fichier
$texte=~/<pubDate>([^>]+)<\/pubDate>/; 

#On a besoin d'avoir cette date en sortie
my $date=$1; 

#Si l'encodage original n'est pas en utf-8/si la valeur de la chaine de caractere dans $encodage transcode en majuscule (ne) on transcode {...} en utf-8
if (uc($encodage) ne "UTF-8") {utf8($date);} 
print OUT2 "<date>".$date."</date>\n"; 
print OUT2 "<items>\n"; 

#----------------------------------------------------------------------------------------------------------
#						FILTRAGE DU TEXTE
#----------------------------------------------------------------------------------------------------------

#Tant qu'on trouve un fichier avec les balises suivants on fait qq chose (.+?) sur toutes les occurrences.  
while ($texte =~ 
/<item><title>(.+?)<\/title>.+?<description>(.+?)<\/description>/g) { 
	
    #On stocke le titre et le resume de l'item
    my $titre=$1; 
    my $resume=$2; 
    if (uc($encodage) ne "UTF-8") {
    	utf8($titre);
    	utf8($resume);
    } 
    
    #On va nettoyer le titre et le resume
    $titre = &nettoietexte($titre); 
    $resume = &nettoietexte($resume); 
    print OUT1 "Titre : $titre \n"; 
    print OUT1 "Resume : $resume \n";; 
    print OUT2 "<item><title>$titre</title><abstract>$resume</abstract></item>\n"; 
} 
print OUT2 "</items>\n</file>\n"; 
close(OUT1); 
close(OUT2); 
close(FILE); 
exit; 

#----------------------------------------------------------------------------------------------------------
#							TRAITEMENT DU REPERTOIRE
#----------------------------------------------------------------------------------------------------------

#La 1ere fois qu'on declare une variable on utilise my, la variable est $rep qui prendra la valeur de l'argument
my $rep="$ARGV[0]";

#On s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;

#Declaration des hash pour (?)
my %dico1=();
my %dico2=();

#Initialisation des variables pour stocker les lignes extraites 1 pour le texte, 2 pour le xml
my $DUMPFULL1="";
my $DUMPFULL2="";

#On initialise une variable contenant le flux de sortie pour le fichier txt 
my $output1="SORTIE.txt";

#S'il n'ouvre pas on arrete le programme
if (!open (FILEOUT,">$output1")) { die "Pb a l'ouverture du fichier $output1"};

#On initialise une variable contenant le flux de sortie pour le fichier xml
my $output2="SORTIE.xml";

#S'il n'ouvre pas on arrete le programme
if (!open (FILEOUT,">$output2")) { die "Pb a l'ouverture du fichier $output2"};

#----------------------------------------

&parcoursarborescencefichiers($rep);	#recurse!

#----------------------------------------

# on precise la formate de sortie a partir des infos suivantes: 
print FILEOUT "<?xml version=\"1.0\" encoding=\"$encodagesortie\" ?>\n";
print FILEOUT "<PARCOURS>\n";
print FILEOUT "<NOM>ERVAS, KHALSA, MORLAINE</NOM>\n";
print FILEOUT "<FILTRAGE>".$DUMPFULL1."</FILTRAGE>\n";
print FILEOUT "</PARCOURS>\n";
close(FILEOUT);
exit;

#----------------------------------------------------------------------------------------------------------
#					LES PROCEDURES POUR PARCOURIR L'ARBORESCENCE
#----------------------------------------------------------------------------------------------------------

#subroutine pour le script
sub parcoursarborescencefichiers {
	
	#Je pense...mnt on est dans le repertoire de l'arborescence
    my $path = shift(@_);
    
    #On ouvre un "directory" repertoire qui s'appele path, si on arrive pas l'ouvrir on interrompt le programme
    opendir(DIR, $path) or die "can't open $path: $!\n";
    
    #On ouvre les fichier pour les lire
    my @files = readdir(DIR);
    closedir(DIR);
    
    #Pour chaque fichier on a une liste/array
    foreach my $file (@files) {
    	
        #Ensuite, si...
        next if $file =~ /^\.\.?$/;
        $file = $path."/".$file;
        if (-d $file) {
            &parcoursarborescencefichiers($file);	#recurse!
        }
        if (-f $file) {
        	
            #Si le fichier a une extension xml on applique les choses suivantes:
            if ($file =~/\.xml$/)
			{
                #On ouvre le fichier $file pour le lire
	        	open (FILEIN, $file);
	        	
                #Tant qu'il y a des lignes dans le fichier, on continue dans la boucle
                while (my $ligne=<FILEIN>){
                    
                    #Si on lit item on l'extrait et on la met dans la variable DUMPFULL1 apres <article> et on retourne à la lgn
                    if($ligne=~m/<item>/) {
                        $DUMPFULL1=$DUMPFULL1."<article>"."\n";
                    }
                    
                    #Si la ligne lit fin item on fait pareil mais on ecrit la balise fin article
                    if($ligne=~m/<\/item>/) {
                        $DUMPFULL1=$DUMPFULL1."\n</article>"."\n";
                    }
                    
                    #Si la ligne lit title puis n'importe quoi suivi de /title
                    if($ligne=~m/<title>([^>]*)<\/title>/) {
                       
                        my $texte=$1;
                        
                        #Si il n'existe pas dans la variable dico - texte
                        if (!(exists ($dico1{$texte}))) {
                            $dico1{$texte}=1;
                            $texte=&nettoietexte($texte);
                            $DUMPFULL2=$DUMPFULL2.$texte."\n";
                            $DUMPFULL1=$DUMPFULL1."<titre>".$texte."</titre>\n";
                        }
                        else {
                            $dico1{$texte}++;
                            $DUMPFULL1=$DUMPFULL1."<title>"."</title>\n";
                        }				
                    }
                    if($ligne=~ m/<description>([^>]*)<\/description>/) {
                        my $texte = $1;
            	if (!(exists ($dico2{$texte}))) {
			    	$dico2{$texte}=1;
                   	$texte=&nettoietexte($texte);
                  	$DUMPFULL2=$DUMPFULL2.$texte."\n";
                  	$DUMPFULL1=$DUMPFULL1."<abstract>".$texte."</abstract>\n";
                 }
                 else {
                 	$dico1{$texte}++;
                  	$DUMPFULL1=$DUMPFULL1."<abstract></abstract>\n";
 					}
   
                   		}
           			}
                close (FILEIN);
            }
            #       TRAITEMENT à réaliser sur chaque fichier
            #       Insérer ici votre code (le filtreur)
            print $i++,"\n";
        }
    }
}


#----------------------------------------------------------------------------------------------------------
#							NETTOYAGE DU TEXTE
#----------------------------------------------------------------------------------------------------------

#On nettoie le texte, on remplace certains elements par d'autres 
sub nettoietexte { 
	
    #Shift prend la 1ere valeur de la liste (eng= array) et l'enleve (shifts it off) et retourne une valeur de la liste, moins la 1ere valeur, on se balade dans le texte
    my $texte=shift; 
    
    $texte =~ s/&lt;/</g; #On remplace &lt par l'élément correspondant
	$texte =~ s/&gt;/>/g;
	$texte =~ s/<a href[^>]+>//g;
	$texte =~ s/<img[^>]+>//g;
	$texte =~ s/<\/a>//g;
	$texte =~ s/&#38;#39;/'/g;
	$texte =~ s/&#38;/&/g;
	$texte =~ s/&amp;#39;/'/g;
	$texte =~ s/&#39;/'/g;
	$texte =~ s/&#38;#34;/"/g;
	$texte =~ s/&amp;#34;/"/g;
	$texte =~ s/&#34;/"/g;
	$texte =~ s/&#91;/[/g;
	$texte =~ s/&#93;/]/g;
    $texte =~ s/<[^>]+>//g; #On supprime les balises fermantes
	$texte =~ s/&nbsp;//g; #On supprime les blancs
    return $texte;
}

