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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141 | #/usr/bin/perl
<<DOC;
////////////////////////////////////////////////////////////////////////////////////////////////////////
// //
// Nom : Hayoung SEO //
// Date : Avril 2021 //
// Version Expression Régulière //
// But : Parcourir toute l'arborescence et extraire les contenus textuels de tous les fils RSS //
// Entrée : 1. répertoire(racine) contenant tous les fichiers RSS //
// 2. rubrique à traiter //
// Sortie : Un fichier au format txt + Un fichier au format XML //
// Usage : perl bao1_hayoung_seo.pl repertoire-a-parcourir rubrique //
// Exemple d'usage : perl bao1_hayoung_seo.pl 2020 3208 //
// //
////////////////////////////////////////////////////////////////////////////////////////////////////////
DOC
#-----------------------------------------------------------
use strict;
use utf8;
use Timer::Simple;
my $t = Timer::Simple->new();
$t->start; # timer pour savoir le temps de traitement
#-----------------------------------------------------------
my $rep="$ARGV[0]"; # repertoire à traiter
my $rubrique ="$ARGV[1]"; # rubrique à traiter
# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
# Ouverture des fichiers txt et XML
open my $OUT,">:encoding(utf8)","bao1_sortie_$rubrique.txt";
open my $OUTXML,">:encoding(utf8)","bao1_sortiexml_$rubrique.xml";
# Ecriture de l'en-tête du fichier XML
print $OUTXML "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print $OUTXML "<corpus2020>\n";
my %dico_des_titres=();
my $compteur=0;
#----------------------------------------
# Appel du sous-programme
&parcoursarborescencefichiers($rep); #recurse!
#----------------------------------------
print $OUTXML "</corpus2020>\n";
# Fermeture des fichiers
close $OUT;
close $OUTXML;
print "Temps de traitement : ", $t->elapsed, " secondes\n";
exit;
#----------------------------------------------
# Sous-programme
sub parcoursarborescencefichiers {
my $path = shift(@_);
opendir(my $DIR, $path) or die "can't open $path: $!\n";
# On lit et renvoie comme valeur la liste @files
my @files = readdir($DIR);
closedir($DIR);
# On va examiner un à un pour éviter de lire les fichiers cachés
foreach my $file (@files) {
# Si la condition est vrai on passe à l'itération suivante, on ne veut pas traiter
next if $file =~ /^\.\.?$/; # on ne lit pas les fichiers cachés (. ou .. ) sinon boucle infini
# S'il ne s'agit pas des fichiers cachés, on continue. On relance le parcours
# Reécriture de localisation => on génère le nom relatif
$file = $path."/".$file;
# d : directory(repertoire)
# S'il s'agit d'un répertoire……
if (-d $file) {
# Ce qu'on cherche n'est pas un répertoire mais un fichier donc on relance le parcours
# pour qu'on puisse arriver aux fichiers
&parcoursarborescencefichiers($file); #recurse!
# Donc on va parcourir de nouveau, $path devient 2020/01 par exemple … puis 2020/01/01…
# Finalement on va arriver à un fichier
}
# f : file(fichier)
# S'il s'agit d'un fichier……
if (-f $file) {
# On ne veut pas traiter les fichiers qui ne sont pas au format XML
# Donc l'extension doit être .xml
if ($file =~/$rubrique.+xml$/) {
# Impression du traitement en cours dans la console
print $compteur++," Traitement de : ",$file,"\n";
# Ouverture du fichier
open my $FIC,"<:encoding(utf8)",$file;
$/=undef;
my $ligne=<$FIC>;
close $FIC;
# On va extraire les contenus textuels de titre et de description avec expression régulère
while ($ligne=~/<item>.*?<title>(.+?)<\/title>.+?<description>(.+?)<\/description>/gs) {
my $titre=$1; # on récupère le 1er zone de capture (1er parenthèse entre <title></title>)
my $description=$2; # on récupère le 2eme zone de capture (2eme parenthèse)
#$numberItem++;
# On évite de récuperer 2 fois la même information => utilisation de dictionnaire
# Si le titre n'existe pas dans le dico_des_titres
if (!(exists $dico_des_titres{$titre})) {
# On ajoute
$dico_des_titres{$titre}=$description ;
# Appel du sous-programme de nettoyage
($titre,$description)=&nettoyage($titre,$description);
# Ecriture des fichiers de sortie
# 1. Fichier au format txt
print $OUT $titre,"\n";
print $OUT $description,"\n";
print $OUT "$$$\n";
# 2. Fichier au format XML
print $OUTXML "<item>\n";
print $OUTXML "<titre>$titre</titre>\n";
print $OUTXML "<description>$description</description>\n";
print $OUTXML "</item>\n";
}
}
}
}
}
}
#----------------------------------------------
# Sous-programme nettoyage
sub nettoyage {
# On récupère les arguments
my $titre = $_[0];
my $description = $_[1];
# Nettoyage !
# On enlève <![CDATA[ et ]]>
$titre=~s/^<!\[CDATA\[//;
$titre=~s/\]\]>$//;
$description=~s/^<!\[CDATA\[//;
$description=~s/\]\]>$//;
# On enlève ou on remplace
$description=~s/<.+?>//g; # < est le code de < , > est le code de >
$description=~s/&#39;/'/g;
$description=~s/&#34;/"/g;
$titre=~s/<.+?>//g;
$titre=~s/&#39;/'/g;
$titre=~s/&#34;/"/g;
$titre=~s/ / /g;
$description=~s/ / /g;
# On ajoute un point à la fin du titre
# Pour la partie description il y a déjà le point à la fin => rien à faire
$titre=~s/$/\./g;
# S'il y a plusieur points => on ne laisse qu'un seul
$titre=~s/\.+$/\./g;
return $titre,$description;
}
|