La Profondeur : traitement en pur Perl
Ci-dessous le script leMondeProfond.pl.
Téléchargement du programme.
Téléchargement des résultats. XML TXT
#!usr/bin/perl
###################################################
# TODO :
# Ligne 16 (cf 09-03-16.pl, ligne 9)
###################################################
# BUT DU PROGRAMME :
# - prendre en compte l'arborescence
# - appel du programme : perl -w filtrage2.pl "repertoire" "rubrique"
###################################################
######################################### 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)", "$rubrique"."_Profond.txt";
close $out;
#----------------------------------------
# ouverture du fichier XML qui contiendra le texte taggue et balise
my $output1="SORTIE_Profond.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);
#----------------------------------------
# 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.*.txt/) {
# 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)", "$rubrique"."_Profond.txt";
# ouverture de la sortie XML tagguee
open FILEOUT,">>:encoding(utf-8)", "SORTIE_Profond.xml";
# initialisation de la variable $texte
my $texte="";
# pour chaque ligne du fichier en lecture
while (my $ligne = <$in>) {
$ligne =~ s/<.*>.*$|^ +.*$|^[0-9]+.*$|^Article .*$|^Découvrir .*\n$|^Le Monde\n$|^Suivre\n$|^Aller .*\n$|^\n?$//g;
# 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;
#print $ligne;
}
if (! (exists $dico{$ligne})) {
# on l'ajoute a la sortie .txt
print $out "$ligne\n";
$dico{$ligne} = 1;
#Ajout 17/02/16 = appel de l'étiquetage
my ($textetag) = &etiquetage($ligne);
# ecriture du contenu textuel taggue et balise dans le fichier de sortie XML
print FILEOUT "$textetag";
}
}
# fermeture du fichier en lecture
close $in;
# signal dans le shell
print "<",$i++,"> ==> ",$file,"\n";
# fermeture du fichier .txt
close $out;
}
}
}
}
#----------------------------------------------
#Ajout 17/02/16
sub etiquetage {
# contenus textuels du fichier RSS
my ($t) = @_; #my ($x) = @_;
#ouverture d'un fichier temporaire pour TreeTagger
open(TMP, ">:encoding(utf-8)", "texte.txt");
#copie du contenu textuel precedemment extrait dans le fichier temporaire
print TMP $t;
close(TMP);
############## Appel d'un shell pour lancer treetagger ###############
# appel de Tree-tagger
# IN : fichier temporaire | OUT : fichier txt taggue
system("tree-tagger-french \"texte.txt\" > texte_tag.txt");
# appel de treetagger2xml.pl
# IN : fichier txt taggue | OUT : fichier.txt.xml taggue et balise
system("perl treetagger2xml-utf8.pl texte_tag.txt utf-8");
#######################################################################
# ouverture du fichier .txt.xml
open(TMP2, "<:encoding(utf-8)", "texte_tag.txt.xml");
my $t_tag="";
my $ligne = ;
while (my $ligne = ) {
#copie des lignes du fichier taggue et balise dans la variable $t_tag qui sera retournee
$t_tag= $t_tag.$ligne;
}
close(TMP2);
return($t_tag);
}
#########################################################################################