#!/usr/bin/perl
<<DOC;
JANVIER 2018
usage : perl parcours-arborescence-fichiers repertoire-a-parcourir rubrique
Le programme prend en entrée le nom du répertoire contenant les fichiers à traiter
Il 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><CONTENU>du filtrage</CONTENU></FICHIER>
DOC
#--------------------------------------------------------------------------
use utf8;
#Le nom du rép est passé en argument au prog: on le récupère
my $rep = "$ARGV[0]";
my $rubrique="$ARGV[1]";
# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
my %dico;
my $codage="utf-8";
my $compteurfile=1;
my $compteurItem=0;
#on initialise une var contenant le flux de sortie
#On ouvre les deux fichiers de sortie: XML et TXT
#on intègre le contenu de la var contenant le filtrage
my $output1=$rubrique.".xml";
my $output2=$rubrique.".txt";
if (!open (FILEOUT,">:encoding($codage)",$output1)) { die "Pb a l'ouverture du fichier $output1"};
if (!open (FILEOUT2,">:encoding($codage)",$output2)) { die "Pb a l'ouverture du fichier $output2"};
print FILEOUT "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print FILEOUT "<PARCOURS>\n";
print FILEOUT "<NOM>AM , 2017-2018</NOM>\n";
print FILEOUT "<FILTRAGE>\n";
#----------------------------------------------------------------------------
#On lance le parcours récursif de l'arbre des fils RSS
&parcoursarborescencefichiers($rep); #recurse!
if (!open (FILEOUT,">>:encoding($codage)",$output1)) { die "Pb a l'ouverture du fichier $output1"};
print FILEOUT "\n</FILTRAGE>\n";
print FILEOUT "</PARCOURS>\n";
close(FILEOUT);
exit;
#----------------------------------------------------------------------------
#Procédure du parcours de l'arborescence des fils RSS
sub parcoursarborescencefichiers {
my $path= shift(@_);
#On ouvre le rép
opendir (DIR, $path) or die "can't open $path: $!/n";
#on récupère le contenu du rép
my @files=readdir(DIR);
closedir(DIR);
#Pour chacun des éléments contenus dans le rép, on vérifie son statut: rép ou fichier?
foreach my $file (@files) {
next if $file =~ /^\.\.?$/;
#On écrit le chemin complet de l'élément
$file = $path."/".$file;
#Si l'élément est un rép, on relance le parcours de l'arborescence
if (-d $file) {
print "<NOUVEAU REPERTOIRE> ==> ",$file,"\n";
&parcoursarborescencefichiers($file); #recurse!
print "<FIN REPERTOIRE> ==> ",$file,"\n";
}
#Si l'élément est un fichier, on applique les traitements (filtrage) et on imprime les résultats
if (-f $file){
#Traitement à réaliser sur chaque fichier: insérer le filtreur
if ($file=~/$rubrique.+\.xml$/) {
print "<",$compteurfile++,"> ==> ",$file,"\n";
open (FIC, "<:encoding($codage)", $file);
my $texte="";
while (my $ligne = <FIC>) {
chomp $ligne;
$ligne =~ s/\r//g;
$texte = $texte . $ligne;
}
close FIC;
$texte =~ s/>\s+</></g;
#print $texte,"\n";
while ($texte =~m/<item>.*?<title>([^<]*?)<\/title>.*?<description>([^<]*?)<\/description>/g) {
my $titre = $1;
my $description = $2;
($titre,$description) = &nettoyage ($titre,$description);
if (!(exists $dico{$titre})) {
$dico{$titre} = 1;
#if (!open (FILEOUT,">>:encoding($codage)",$output1)) { die "Pb a l'ouverture du fichier $output1"};
#if (!open (FILEOUT2,">>:encoding($codage)",$output2)) { die "Pb a l'ouverture du fichier $output2"};
print FILEOUT2 "§ $titre\n$description \n\n";
#------------------------------------------------------------------------------------------------------------------------------
# Il faut étiqueter le texte des titres et des descriptions avant de les réintégrer dans la sortie XML
#------------------------------------------------------------------------------------------------------
$compteurItem++;
my ($titre_etiq, $description_etiq) = &etiquetage($titre,$description);
print FILEOUT "<item number=\"$compteurItem\">\n<titre>$titre_etiq</titre>\n<description>$description_etiq</description>\n</item>\n"; #close(FILEOUT);
#close(FILEOUT2);
}
}
}
}
}
}
#----------------------------------------------
sub nettoyage {
my $var1 = shift(@_);
my $var2 = shift(@_);
$var1=~s/<.+?>//g;
$var2=~s/<.+?>//g;
$var1.=".";
$var1=~s/\?\.$/\?/;
return $var1,$var2 ;
}
#----------------------------------------------
sub etiquetage {
my $var1 = shift(@_);
my $var2 = shift(@_);
#--- traitement de titre------------------------
open(OUT, ">:encoding(utf-8)", "titre_tmp.txt");
print OUT $var1;
close OUT;
system("perl tokenise-utf8.pl titre_tmp.txt | ./tree-tagger.exe -lemma -token -no-unknown french-utf8.par > titre_tmp_etiq.txt");
system("perl5.16.3 treetagger2xml-utf8.pl titre_tmp_etiq.txt utf8");
$/=undef;
open (FIC, "<:encoding(utf-8)","titre_tmp_etiq.txt.xml");
my $titre_retour=<FIC>;
$titre_retour =~s/<\?xml version="1\.0" encoding="utf-8" standalone="no"\?>\r\n//;
#--- traitement de description------------------------
open(OUT, ">:encoding(utf-8)", "description_tmp.txt");
print OUT $var2;
close OUT;
system("perl tokenise-utf8.pl description_tmp.txt | ./tree-tagger.exe -lemma -token -no-unknown french-utf8.par > description_tmp_etiq.txt");
system("perl5.16.3 treetagger2xml-utf8.pl description_tmp_etiq.txt utf8");
#$/=undef;
open (FIC, "<:encoding(utf-8)","description_tmp_etiq.txt.xml");
my $description_retour=<FIC>;
$description_retour =~s/<\?xml version="1\.0" encoding="utf-8" standalone="no"\?>\r\n//;
#------------------------------------------
#--- c'est fini------------------------
return $titre_retour, $description_retour;
}