#/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 : Nataly Jahchan; Maria Goryainova 
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-------------#


# On definit la variable qui comporte l'information "utf-8" 
my $encodagesortie="utf-8"; 

# On recupere l'encodage dans chaque fichier RSS
my $encodage=`file -I $ARGV[0] | cut -d= -f2`; 
print "ENCODAGE : $encodage \n"; 

# On supprime les saut de ligne dans les fichiers
chomp($encodage); 

# On ouvre chaque fichier en lecture en specifiant l'encodage 
open(FILE,"<:encoding ($encodage)",$ARGV[0]); 

# On ouvre les fichiers de sortie dont l'encodage doit etre utf-8 et ou on va stocker le resultat
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 veut avoir le texte sur une seule ligne, pour que ca soit le meme format pour pouvoir faire le filtrage du texte facilement. Pour cette raison on a supprime les retours a la ligne 

# On cree une variable qui n'a rien pour valeur
my $texte=""; 

# On parcourt les fichiers ouverts en lecture ligne par ligne
while (my $ligne=<FILE>) { 
 
 # On supprime les retour a la ligne en utilisant l'expression reguliere 
 $ligne =~ s/\n//g; 
 
 # On concatene chaque ligne en les mettant dans la variable $texte
 $texte .= $ligne; 
} 

# On fait le nettoyage du texte en enlevant les espaces entre les balises dans chaque ligne mise dans $texte
$texte =~ s/> *</></g; 

# On recupere la date du fichier pour la mettre en sortie apres
$texte=~/<pubDate>([^>]+)<\/pubDate>/; 

# On cree une variable pour la date recuperee
my $date=$1; 

# Si l'encodage de la date n'est pas utf-8, on le convertit en utf-8
if (uc($encodage) ne "UTF-8") {utf8($date);} 

# On concatene les dates recuperee en les affichant sur l'ecran
print OUT2 "<date>".$date."</date>\n"; 

print OUT2 "<items>\n"; 

#-------------------FILTRAGE DU TEXTE--------------------#


# On cherche des balises indiquees, une fois trouvees, pour toutes les occurrences on procede a la procedure a l'interieur de la boucle   
while ($texte =~ 
/<item><title>(.+?)<\/title>.+?<description>(.+?)<\/description>/g) { 
	
    # On stocke le titre et le resume de l'item dans des variables correspondantes
    my $titre=$1; 
    my $resume=$2; 
	
	# Si l'encodage du titre et du resume n'est pas utf-8, on les convertis en utf-8
    if (uc($encodage) ne "UTF-8") {
    	utf8($titre);
    	utf8($resume);
    } 
    
    #On nettoie 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; 


# On declare une variable qui va correspondre au premier argument de la ligne de commande (le premier fichier que l'on traite) 
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 les dicos
my %dico1=();
my %dico2=();

#On declare des variables pour stocker les lignes extraites pour le texte brut et pour le xml
my $DUMPFULL1="";
my $DUMPFULL2="";

#On declare 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 le format de sortie selon des informations suivantes: 
print FILEOUT "<?xml version=\"1.0\" encoding=\"$encodagesortie\" ?>\n";
print FILEOUT "<PARCOURS>\n";
print FILEOUT "<NOM>Jahchan, Goryainova</NOM>\n";
print FILEOUT "<FILTRAGE>".$DUMPFULL1."</FILTRAGE>\n";
print FILEOUT "</PARCOURS>\n";
close(FILEOUT);
exit;

#----------------------------------------------------------------------------------------------------------
#					LES PROCEDURES POUR PARCOURIR L'ARBORESCENCE
#----------------------------------------------------------------------------------------------------------

#On cree un sous-programme - sub pour le script
sub parcoursarborescencefichiers {
	
	# On divise l'arborescence a parcourir selon des fichiers
    my $path = shift(@_);
    
    #On ouvre le premier fichier correspondant a la variable $path, sinon, on arrete le programme
    opendir(DIR, $path) or die "can't open $path: $!\n";
    
    #On stocke le contenu du repertoire dans le tableau files
    my @files = readdir(DIR);
    closedir(DIR);
    
    #Pour chaque fichier on a une liste
    foreach my $file (@files) {
    	
        #Ensuite, si le fichier comporte n'importe quel caractere sauf le caractere de la nouvelle ligne, on concatene les valeur de $path et $file (les lignes) en les separant par un "/"
        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 en lecture
	        	open (FILEIN, $file);
	        	
                #Pour chaque ligne on applique les conditions de la boucle:
                while (my $ligne=<FILEIN>){
                    
                    #Si on retrouve la balise "item" sur la ligne, on la met dans la variable $DUMPFULL1, apres on fait la concatenation avec la balise "article" en les mettant dans la meme variable et on retourne à la lgn
                    if($ligne=~m/<item>/) {
                        $DUMPFULL1=$DUMPFULL1 . "<article>"."\n";
                    }
                    
                    # On fait la meme chose avec les balises fermantes - </item> sera concatenee a </article> et mises dans la variable $DUMPFULL1
                    if($ligne=~m/<\/item>/) {
                        $DUMPFULL1=$DUMPFULL1 . "\n</article>"."\n";
                    }
                    
                    #Si la ligne lit la balise title puis n'importe quoi suivi de la balises fermante </title>, on applique des choses suivantes:
                    if($ligne=~m/<title>([^>]*)<\/title>/)  {
                       
                        my $texte = $1;
                        
                        #S'il n'existe pas dans la variable dico - texte
                        if (!(exists ($dico1{$texte}))) {
                            $dico1{$texte}=1;
							
							#On fait le nettoyage du texte, on met la valeur de $texte dans la variable $DUMPFULL1 en concatenant avec le contenu qui y est deja stocke
                            $texte=&nettoietexte($texte);
                            $DUMPFULL2=$DUMPFULL2 . $texte . "\n";
							
							#On fait la concatenantion aussi avec les balises <titre> et </titre>
                            $DUMPFULL1=$DUMPFULL1 . "<titre>" .$texte. "</titre>\n";
                        }
                        else 
						
						#Si cela existe deja dans le dico, on incremente le texte (on poursuit a la ligne suivante) et on concatene le contenu de $DUMPFULL1 avec les balises ouvrante et fermante de titre
						{
                            $dico1{$texte}++;
                            $DUMPFULL1 = $DUMPFULL1."<title> </title>\n";
                        }				
                    }
					
					#On effectue la meme procedure avec les balises <description> et </description>, on veut mettre le texte correspondant a ces balise dans $DUMPFULL1 en ajoutant les balises <abstract> et </abstract> dans la meme variable en encadrant le texte recupere de la description
                    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);
            }
            
            print $i++,"\n";
        }
    }
}


#--------------NETTOYAGE DU TEXTE------------------------#

#Le sous-programme sub

#On nettoie le texte en remplacant certains elements par d'autres 
sub nettoietexte { 
	
    #Shift prend la 1ere valeur de la liste et l'enleve 
    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;
}

