#/usr/bin/perl
<<DOC;
JANVIER 2018
usage : perl parcours-arborescence-fichiers repertoire-a-parcourir
Le programme prend en entrée le nom du répertoire contenant les fichiers à traiter
DOC
#-----------------------------------------------------------
my $rep="$ARGV[0]";
# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
my $rubrique = "$ARGV[1]";
my %redontant;
open(FILEOUT1, ">:encoding(utf8)", "sortie_bao1_$rubrique.txt");
close FILEOUT1;
open(FILEOUT2, ">:encoding(utf8)", "sortie_bao1_$rubrique.xml");
print FILEOUT2 "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print FILEOUT2 "<PARCOURS>\n";
print FILEOUT2 "<FILTRAGE>\n";
close FILEOUT2;
#----------------------------------------
&parcoursarborescencefichiers($rep); # on lance la récursion.... et elle se terminera après examen de toute l'arborescence
#----------------------------------------
open(FILEOUT2, ">>:encoding(utf8)", "sortie_bao1_$rubrique.xml");
print FILEOUT2 "</FILTRAGE>\n";
print FILEOUT2 "</PARCOURS>\n";
close FILEOUT2;
exit;
#----------------------------------------------
sub parcoursarborescencefichiers {
my $path = shift(@_);
opendir(DIR, $path) or die "can't open $path: $!\n";
my @files = readdir(DIR);
closedir(DIR);
foreach my $file (@files) {
next if $file =~ /^\.\.?$/; #passer au prochain si
$file = $path."/".$file;
if (-d $file) { #si c'est un repertoire
print "<NOUVEAU REPERTOIRE> ==> ",$file,"\n";
&parcoursarborescencefichiers($file); #recurse!
print "<FIN REPERTOIRE> ==> ",$file,"\n";
}
if (-f $file) { #si c'est un fichier
# TRAITEMENT à réaliser sur chaque fichier
# Insérer ici votre code (le filtreur)
#print "1\n";
if ($file =~ m/$rubrique.+\.xml$/)
{
#print "2\n";
my $ensemble="";
open(FILEIN, "<:encoding(utf8)", $file);
open(FILEOUT1, ">>:encoding(utf8)", "sortie_bao1_$rubrique.txt");
open(FILEOUT2, ">>:encoding(utf8)", "sortie_bao1_$rubrique.xml");
while (my $ligne= <FILEIN>)
{
#print "3\n";
chomp $ligne; #$ligne=~s/^ +//; # on supprime les blancs au début : pas bien ! #
$ligne =~ s/\r//g;
$ligne=~s/\s*$//; # on supprime les blancs au début : pas bien !
$ensemble = $ensemble.$ligne ;
}
$ensemble =~ s/>\s+</></g;
#print "4\n";
#print $ensemble; # post nettoyage : supprimer les blancs entre balises... # A FAIRE : ... # parcours de $ensemble à la recherche des titres
while($ensemble=~ m/<item>.*?<title>([^<]*?)<\/title>.*?<description>([^<]*?)<\/description>.*?<\/item>/g)
{
#print "5\n";
#print "Titre : $1\n";
#print "Description : $2\n";
my $titre = $1;
my $description = $2;
if ( !exists $redontant{$titre} )
{
$redontant{$titre} = 1;
my ($titre_propre, $description_propre) = &nettoyage($titre, $description);
print FILEOUT1 "$titre_propre",".","\n";
print FILEOUT1 "$description_propre\n";
print FILEOUT2 "<item><titre>$titre_propre</titre><description>$description_propre</description></item>\n";
}
}
close FILEIN;
close FILEOUT1;
close FILEOUT2;
}
print "<",$i++,"> ==> ",$file,"\n";
}
}
}
sub nettoyage {
# my $var1 = $_[0];
#my $var1 = shift(@_);
#my $var2 = shift(@_);
my ($a, $b) = @_;
$a =~ s/<.+?>//g;
$b =~ s/<.+?>//g;
$a =~ s/&/&/g;
$b =~ s/&/&/g;
return $a, $b;
}