1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108 | #/usr/bin/perl
<<DOC;
CARON Juliette REY Camille
2020
usage : perl bao1_xml_carrey.pl repertoire-a-parcourir rubrique
Le programme prend en entrée le nom du répertoire-racine contenant les fichiers
à traiter et le nom de la rubrique à traiter parmi ces fichiers - extraction via module XML:RSS
DOC
#--------------------------------------------------------------------------------------------
# utilisation du module :
use XML::RSS;
#Récupération des arguments de notre programme:
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/[\/]$//;
#Initialisation d'un compteur et d'une table (dico) pour les doublons
my $i=0;
my %doublons=();
#fichier de sortie
open(FICOUT, ">:encoding(utf8)", "./SORTIE2/sortie_bao1_$rubrique.txt") or die("Ouverture a échoué");
open(FICOUTXML, ">:encoding(utf8)", "./SORTIE2/sortie_bao1_$rubrique.xml") or die("Ouverture a échoué");
#Ecriture du début du fichier xml
print FICOUTXML "<?xml version=\"1.0\" encoding=\"utf8\" ?>\n";
print FICOUTXML "<articles rubrique=\"$rubrique\">\n";
#----------------------------------------
#parcours de l'arborescence via une fonction récursive
&parcoursarbo($rep);
#----------------------------------------
#Fermeture des fichiers
print FICOUTXML "</articles>";
close(FICOUT);
close(FICOUTXML);
exit;
#----------------------------------------
sub parcoursarbo {
my $path = shift(@_); #chemin du premier element
opendir(DIR, $path) or die "can't open $path: $!\n";#ouverture repertoire (ou probleme)
my @files = readdir(DIR); #extraction du contenu du repertoire
closedir(DIR); #fermeture repertoire
foreach my $file (@files) { #boucle sur tous les éléments du contenu du repertoire
next if $file =~ /^\.\.?$/; #passer a l'élément suivant s'il s'agit d'un repertoire caché/./..
$file = $path."/".$file; #chemin relatif de l'élément traité
if (-d $file) { # si l'élément est un répertoire
&parcoursarbo($file); #récursion!
}
if (-f $file) { # si l'élément est un fichier
if ($file=~/$rubrique.+\.xml$/) { #si le fichier correspond a un fichier xml contenant la rubrique qu'on chercher
print $i++," Traitement de : ",$file,"\n";
my $rss=new XML::RSS;
eval {$rss->parsefile($file); };
if( $@ ) {
print STDERR "\nERREUR dans le fichier '$file':\n$@\n";#gérer le cas d'une erreur de parsing (style fichier mal formé), message d erreur et on continue
}
else{
foreach my $item (@{$rss->{'items'}}) {
my $titre=$item->{'title'}; # Extraction du titre
my $description=$item->{'description'}; # Extraction de la description
($titre, $description) = &nettoyage($titre, $description); #nettoyer tout ça
if ( !(exists $doublons{$titre}) ) { #ne pas réécrire de doublon
$doublons{$titre} = $description;
#ecriture dans fichier txt
print FICOUT "$titre\n";
print FICOUT "$description\n\n";
#ecriture dans fichier xml
print FICOUTXML "\t<item>\n";
print FICOUTXML "\t\t<titre>$titre</titre>\n";
print FICOUTXML "\t\t<description>$description</description>\n";
print FICOUTXML "\t</item>\n";
}
}
}
}
}
}
}
#----------------------------------------------
sub nettoyage { #remplacer les codes des guillemets, apostrophes etc par ce qui leur correspond
my $titre = $_[0];
my $description = $_[1];
$titre=~s/^<!\[CDATA\[//;
$titre=~s/\]\]>$//;
$description=~s/^<!\[CDATA\[//;
$description=~s/\]\]>$//;
$description=~s/<.+?>//g;
$description=~s/&#39;/'/g;
$description=~s/&#34;/"/g;
$titre =~ s/&(amp;)?/et/g;
$description =~ s/&(amp;)?/et/g;
$titre=~s/<.+?>//g;
$titre=~s/&#39;/'/g;
$titre=~s/&#34;/"/g;
$titre=~s/$/\./g;
return $titre,$description;
}
|