La Surface : traitement en pur Perl
Ci-dessous le script leMondeEnSurface.pl.
Téléchargement du programme.
Téléchargement des résultats. XML TXT
#!usr/bin/perl
###################################################
# BUT DU PROGRAMME :
# - prendre en compte l'arborescence
# - appel du programme : perl -w leMondeEnSurface.pl "2015" "3210"
###################################################
######################################### MAIN #########################################
my $rubrique = "$ARGV[1]";
#my @rubrique = ("0,57-0,64-823353,0", "0,2-3214,1-0,0", "0,2-3232,1-0,0", "0,2-3238,1-0,0");
# ouverture du repertoire
my $rep="$ARGV[0]";
# suppression du dernier "/"
$rep=~ s/[\/]$//;
# initialisation de la variable de sortie
#my $DUMPFULL1="";
#----------------------------------------
# creation du fichier .txt de sortie
open my $out, ">:encoding(utf-8)", "SORTIE_Surface.txt";
close $out;
#----------------------------------------
# ouverture du fichier XML qui contiendra le texte taggue et balise
my $output1="SORTIE_Surface.xml";
if (!open (FILEOUT,">$output1")) { die "Pb a l'ouverture du fichier $output1"};
# ecriture de l'en-tete du fichier XML.
print FILEOUT "\n";
print FILEOUT "\n";
print FILEOUT "G. Chaminade, C. Monnin \n";
# fermeture du fichier qui sera rouvert dans procedure &parcoursarborescencefichiers
close(FILEOUT);
#----------------------------------------
# appel de la fonction qui parcourt l'aborescence et extrait les contenus textuels
&parcoursarborescencefichiers($rep);
#----------------------------------------
#open $out, ">>:encoding(utf-8)", "SORTIE_Surface.txt";
#print $out $DUMPFULL1;
#close $out;
# rouverture du fichier XML contenant le texte taggue et balise
open (FILEOUT,">>:encoding(utf-8)", $output1);
# fermeture de la balise racine
print FILEOUT " \n";
close(FILEOUT);
exit;
#########################################################################################
############################### Definition des fonctions ################################
#----------------------------------------------
sub parcoursarborescencefichiers {
# creation d'un dictionnaire qui contiendra
my %dico;
# creation de la variable path qui contient le chemin passe en parametre a la procedure
my $path = shift(@_);
# ouverture du dossier indiqué dans le path
opendir(DIR, $path) or die "can't open $path: $!\n";
# lecture du repertoire et stockage des noms de contenu dans l'array @files
my @files = readdir(DIR);
# fermeture du repertoire
closedir(DIR);
# boucle sur le contenu de l'array
foreach my $file (@files) {
# elimination des dossiers ./ et ../
next if $file =~ /^\.\.?$/;
# stockage du chemin complet dans $file
$file = $path."/".$file;
# si $file est un repertoire :
if (-d $file) {
print " ==> ",$file,"\n";
# recursion de la procedure
&parcoursarborescencefichiers($file);
print " ==> ",$file,"\n";
}
# si $file est un fichier :
if (-f $file) {
# si $file correspond à la rubrique passee en parametre :
if ($file =~ /$rubrique.*\.xml/) {
# ouverture du fichier en lecture
open my $in, "<:encoding(utf-8)", $file;
# ouverture de la sortie en ecriture qui contiendra les donnes textuelles brutes
open $out, ">>:encoding(utf-8)", "SORTIE_Surface.txt";
# ouverture de la sortie XML tagguee
open FILEOUT,">>:encoding(utf-8)", "SORTIE_Surface.xml";
# initialisation de la variable $texte
my $texte="";
# pour chaque ligne du fichier en lecture
while (my $ligne = <$in>) {
# si le fichier a des retours chariot windows :
if ($ligne =~/\r\n/){
# on les elimine
$ligne=~ s/\r\n//;
}
# sinon
else{
# on chompe
chomp $ligne;
}
# premiere suppression des caracteres mal codes par leur equivalent lisible
$ligne =~ s/'/'/;
# suppression des entites xml
$ligne =~ s/<.+?>//g;
$ligne =~ s/&//g;
# on concatène les lignes après avoir chompé les \n
$texte = $texte.$ligne;
# deuxieme suppression
if ($texte =~/'/){
$texte =~ s/'/'/g;
}
}
# on supprime les delimiteurs non textuels entre les balises XML
$texte =~ s/>\s+ pas pris en compte dans le stockage des var par défaut
# on lit les lignes qui matchent les balises title et description
while ($texte =~/([^<]+?)<\/title><link>(?:[^<]+?)<\/link><description>([^<]+?)<\/description>/g){
#print "$1 $2 \n";
# on recupere le contenu textuel des lignes
my $titre = $1;
my $description = $2;
# on ajoute un point final a la fin du titre
$titre.=".";
# et on le supprime si le titre finit par un ?
$titre=~s/\?\.$/\?/;
# si le texte contenu dans $titre n'est pas dans le dico :
if (! (exists $dico{$titre})) {
# on l'ajoute a la sortie .txt
print $out "TITRE : $titre\n";
#DUMPFULL1= $DUMPFULL1.$titre;
# on cree une entree dans le dico
$dico{$titre} = 1;
}
# idem avec description
if (! (exists $dico{$description})) { #Suppression des doublons
print $out "DESCRIPTION : $description\n\n";
#$DUMPFULL1= $DUMPFULL1.$description;
$dico{$description} = 1;
}
#Ajout 17/02/16 = appel de l'étiquetage
my ($titretag, $descriptiontag) = &etiquetage($titre,$description);
# ecriture du contenu textuel taggue et balise dans le fichier de sortie XML
print FILEOUT "<item>\n<title>\n$titretag\n \n";
print FILEOUT "\n$descriptiontag\n \n;
while (my $ligne = ) {
#copie des lignes du fichier tagge et balise dans la variable $t_tag qui sera retournee
$t_tag= $t_tag.$ligne;
}
close(TMP2);
#Idem pour description
open(TMP, ">:encoding(utf-8)", "description.txt");
print TMP $d;
close(TMP);
system("tokenize.pl \"description.txt\"|tree-tagger-french > description_tag.txt");
system("perl treetagger2xml-utf8.pl description_tag.txt utf-8");
open(TMP2, "<:encoding(utf-8)", "description_tag.txt.xml");
my $d_tag="";
my $ligne = ;
while (my $ligne = ) {
$d_tag= $d_tag.$ligne;
}
close(TMP2);
# retour des variable $t_tag et $d_tag qui contiennent le contenu textuel taggue et balise.
return($t_tag,$d_tag);
}
#########################################################################################