1 #!usr/bin/perl
  2 
  3 # But du programme : Parcours de l'arborescence d'un dossier, affichage du contenu des fichiers présents, traitement d'extraction des balises title et description selon 4 méthodes.
  4 # Fonctionnement : perl+nom_du_programme+nom_de_dossier pour le lancer
  5 
  6 use strict;
  7 use warnings;
  8 use 5.014;
  9 use Switch;
 10 use Data::Dumper;
 11 use XML::RSS;
 12 #use File::Slurp;
 13 
 14 
 15 #use locale; # intégration des accents facilitée
 16 #use utf8;
 17 # Main
 18 
 19 die "Pour $0 syntaxe correcte : perl $0 nom_repertoire " unless @ARGV == 1;
 20 
 21 my $racine = $ARGV[0];
 22 my $saveDir = "$ARGV[0]";
 23 print "répertoire de départ : $racine\n";
 24 #On efface les dossiers antérieures portant le même nom
 25 system("rm -rf RESULTAT_EXTRACTION");
 26 mkdir ("RESULTAT_EXTRACTION");
 27 my $saveName;
 28 my %dejaOuvertHtml1=();
 29 my %dejaOuvertXml1=();
 30 my $encodage=0;
 31 my %testExistenceTitreTXT=();
 32 my %testExistenceTitreHTML=();
 33 my %testExistenceTitreXML=();
 34 my %testExistenceTitreXMLRSS=();
 35 
 36 
 37 lectureDossier1($racine);
 38 lectureDossier2("RESULTAT_EXTRACTION");
 39 
 40 
 41 
 42 #étape 1 : Vérification :
 43 #1-1 : Dossier ou fichier ?
 44 #1-2 : Restriction, ne pas utiliser les dossiers . ou ..
 45 
 46 sub lectureDossier1
 47 {
 48     my ($dossierEnCours) = @_;
 49     #say "$dossierEnCours";
 50     opendir (my $D, $dossierEnCours)  or die "Erreur d'ouverture de dossier type : $!";
 51     #print "Dossier ouvert : $D\n";
 52     foreach my $x (readdir ($D))
 53     {
 54             $saveName=$x;
 55             $x=$dossierEnCours."/".$x;
 56         #print "fichier traité : $x\n";
 57         #next if (($x eq ".") or ($x eq ".."));
 58         #print "fichier traité après exclusion : $x\n";
 59             next if $x=~ /^\.|\.\.?$/;
 60         if (-d $x)
 61         {
 62             lectureDossier1($x);
 63             #say "$x est un dossier";
 64         }
 65         elsif (-f $x)
 66         {
 67             #say "$x est un fichier";
 68             traitementXML($x);
 69         }
 70     }
 71     closedir $D;
 72 };
 73 # ajout des footers si .html ou .xml
 74 sub lectureDossier2
 75 {
 76     my ($dossierEnCours) = @_;
 77     my $compteur=0;
 78     opendir (my $D, $dossierEnCours)  or die "Erreur d'ouverture de dossier type : $!";
 79     foreach my $x (readdir ($D))
 80     {
 81         $saveName=$x;
 82         $x=$dossierEnCours."/".$x;
 83         next if $x=~ /^\.|\.\.?$/;
 84         if (-d $x)
 85         {
 86             lectureDossier2($x);
 87         }
 88         elsif (-f $x)
 89         {
 90             if ($x=~ /.*\.html$/)
 91             {
 92                 open (my $finalHtml, ">>", "$x");
 93                 footerHtml($finalHtml);
 94             }
 95             if ($x=~ /.*\.xml$/)
 96             {
 97                 open (my $finalXml, ">>", "$x");
 98                 footerXML($finalXml);
 99 
100             }
101             if ($x=~ /.*\.txt$/)
102             {
103                 #   mkdir ("./RESULTAT_EXTRACTION/dossierTXTtreetagger");
104                 #   system("cat $x|/home/joe/treetagger/cmd/tree-tagger-french-utf8 >> ./RESULTAT_EXTRACTION/dossierTXTtreetagger/$compteur");
105                 #$compteur++;
106             }
107 
108 
109         }
110     }
111     closedir $D;
112 };
113 
114 
115 
116 #étape 2 : vérification du format de fichier (si .xml on traite, sinon pas d'utilisation)
117 
118 sub traitementXML
119 {
120     my ($fichier)=@_;
121     if ($fichier=~ /.*\.xml/)
122     {
123         #say "$fichier est un fichier xml";
124         evaluation($fichier);
125     }
126 
127 }
128 
129 #étape 3 : evalue et établit l'arborescence 
130 
131 sub evaluation
132 {
133 
134 my ($fichier)=@_;
135 my $ligne;
136 my $texte;
137 my $rubrique;
138 
139 open (my $IN3, "<", "$fichier");
140 while ($ligne=<$IN3>)
141 {
142 $ligne=~ s/\n//g;
143 $texte.=$ligne;
144 }
145 
146 
147     if ($texte=~/<channel>.*?<title>(.*?)<.title>/g)
148     {
149     $rubrique=$1;
150     }
151     if (defined($rubrique))
152     {
153     #   $rubrique= substr($rubrique,14);
154         say $rubrique;
155         $rubrique= nettoyageRubrique($rubrique);
156         #say $rubrique;
157         extractionTXT($fichier,$rubrique);
158         extractionHTML($fichier,$rubrique);
159         extractionXML($fichier,$rubrique);
160         extractionXMLRSS($fichier,$rubrique);
161     }
162     close $IN3;
163 }
164 
165 #étape 3.1 : nettoyage des noms de rubrique
166 
167 sub nettoyageRubrique
168 {
169 my ($element) = @_;
170 
171 my %hash=(
172 "à"=>"a",
173 "â"=>"a",
174 "é"=>"e",
175 "è"=>"e",
176 "ê"=>"e",
177 "ë"=>"e",
178 "\x{E9}"=>"e",#É
179 "î"=>"i",
180 "ï"=>"i",
181 "ï"=>"i",
182 "î"=>"i",
183 "ô"=>"o",
184 "û"=>"u",
185 "ü"=>"u",
186 ","=>" ",
187 " "=>"_",
188 "Le Monde.fr"=>"",
189 "LeMonde.fr"=>""
190 );
191 foreach my $key (keys %hash)
192 {
193  $element=~ s/$key/$hash{$key}/g;
194 }
195     $element=uc($element);
196     foreach my $change ($element)
197     {
198     $change=~ s/_-_//g;
199     $change=~ s/_:_/_/g;
200     $change=~ s/_\.//g;
201     }
202     return $element;
203 }
204 
205 
206 #étape 4.1.1 : Extraction TXT par rubrique
207 sub extractionTXT
208 {
209     my ($fichier,$rubrique)=@_;
210     $encodage=detectionEncodage($fichier);
211     mkdir ("./RESULTAT_EXTRACTION/$encodage");
212     mkdir ("./RESULTAT_EXTRACTION/$encodage/$rubrique");
213     open (my $IN4, "<:encoding($encodage)", "$fichier") or die "Erreur 4IN : $!";
214     $saveName=~ s/xml/txt/g;
215     my $chemin="./RESULTAT_EXTRACTION/$encodage/$rubrique/$saveName";
216     open (my $OUT4, ">>:encoding($encodage)", "$chemin") or die "Erreur 4OUT : $!";
217     my $ligne;
218     my $texte;
219     my $titre;
220     my $description;
221 
222 
223     while ($ligne=<$IN4>)
224     {
225         $ligne=~ s/\n//g;
226         $texte.=$ligne;
227     }
228     $texte=nettoyageFichier($texte);
229     while ($texte=~ m/<item>.*?<title>(.*?)<.title>.*?<description>(.*?)<.description>/g)
230     {
231         $titre=$1;
232         $description=$2;
233 
234         unless (exists ($testExistenceTitreTXT{$titre}))
235             {
236                 $testExistenceTitreTXT{$titre}++;
237                 say $OUT4 "*";
238                 say $OUT4 "titre : $titre";
239                 say $OUT4 "description : $description";
240             }
241     }
242     close $IN4;
243     close $OUT4;
244 }
245 
246 
247 #étape 4.1.2 : Extraction Html par rubrique
248 sub extractionHTML
249 {
250         my ($fichier,$rubrique)=@_;
251         $encodage=detectionEncodage($fichier);
252         mkdir ("./RESULTAT_EXTRACTION/$encodage");
253         mkdir ("./RESULTAT_EXTRACTION/$encodage/$rubrique");
254         open (my $IN4, "<:encoding($encodage)", "$fichier") or die "Erreur 4IN : $!";
255         $saveName=~ s/txt/html/g;
256         my $chemin="./RESULTAT_EXTRACTION/$encodage/$rubrique/$saveName";
257         open (my $OUT4, ">>:encoding($encodage)", "$chemin") or die "Erreur 4OUT : $!";
258         my $ligne;
259         my $texte;
260         my $titre;
261         my $description;
262 
263 
264         while ($ligne=<$IN4>)
265         {
266             $ligne=~ s/\n//g;
267             $texte.=$ligne;
268         }
269 
270         $texte=nettoyageFichier($texte);
271         if (!exists($dejaOuvertHtml1{"$encodage/$rubrique/$saveName"}))
272         {
273             headerHtml($OUT4);
274             $dejaOuvertHtml1{"$encodage/$rubrique/$saveName"}++;
275         }
276         while ($texte=~/<item>.*?<title>(.*?)<.title>.*?<description>(.*?)<.description>/g)
277         {
278             $titre=$1;
279             $description=$2;
280             unless (exists($testExistenceTitreHTML{$titre}))
281             {
282             $testExistenceTitreHTML{$titre}++;
283             say $OUT4 "<tr><td colspan=\"2\" align=\"center\" bgcolor=\"beige\">$fichier/$rubrique</td></tr>";
284             say $OUT4 "<tr><td>titre : $titre</td>";
285             say $OUT4 "<td>description : $description</td></tr>";
286             }
287         }
288         close $IN4;
289         close $OUT4;
290 }
291 #étape  4.1.2 : extraction XML classée par rubrique
292 sub extractionXML
293 {
294     my ($fichier,$rubrique)=@_;
295     $encodage=detectionEncodage($fichier);
296     mkdir ("./RESULTAT_EXTRACTION/$encodage");
297     mkdir ("./RESULTAT_EXTRACTION/$encodage/$rubrique");
298     open (my $IN4, "<:encoding($encodage)", "$fichier") or die "Erreur 4IN : $!";
299     my $saveNameXML = $saveName;
300     $saveNameXML=~ s/html/xml/g;
301     my $chemin="./RESULTAT_EXTRACTION/$encodage/$rubrique/$saveNameXML";
302     open (my $OUT4, ">>:encoding($encodage)", "$chemin") or die "Erreur 4OUT : $!";
303     my $ligne;
304     my $texte;
305     my $titre;
306     my $description;
307 
308 
309     while ($ligne=<$IN4>)
310     {
311         $ligne=~ s/\n//g;
312         $texte.=$ligne;
313     }
314     $texte=nettoyageFichier($texte);
315 
316     if (!exists($dejaOuvertXml1{"$encodage/$rubrique/$saveNameXML"}))
317     {
318         headerXML($OUT4);
319         $dejaOuvertXml1{"$encodage/$rubrique/$saveNameXML"}++;
320     }
321 
322     while ($texte=~/<item>.*?(<title>.*?<.title>).*?(<description>.*?<.description>)/g)
323     {
324         $titre=$1;
325         $description=$2;
326         unless(exists($testExistenceTitreXML{$titre}))
327         {
328             $testExistenceTitreXML{$titre}++;
329             say $OUT4 "<dossier>$fichier/$rubrique</dossier>";
330             say $OUT4 "$titre";
331             say $OUT4 "$description";
332         }
333     }
334 
335     close $IN4;
336     close $OUT4;
337 
338 }
339 
340 sub extractionXMLRSS
341 {
342     my ($fichier,$rubrique)=@_;
343     my $rss = new XML::RSS;
344     $encodage=detectionEncodage($fichier);
345     mkdir ("./RESULTAT_EXTRACTION/$encodage");
346     mkdir ("./RESULTAT_EXTRACTION/$encodage/$rubrique");
347     my $saveNameXMLRSS = $saveName;
348     $saveNameXMLRSS=~ s/html/txt/g;
349     my $chemin="./RESULTAT_EXTRACTION/$encodage/$rubrique/xmlrss_$saveNameXMLRSS";
350     open (my $OUT5, ">>:encoding($encodage)", "$chemin") or die "Erreur 5OUT : $!";
351     $rss->parsefile($fichier);
352     my $texte;
353 
354     foreach my $objet (@{$rss->{items}})
355     {
356       my $titre = $objet->{'title'};
357       my $description = $objet->{'description'};
358 
359       unless (exists ($testExistenceTitreXMLRSS{$titre}))
360       {
361         $texte=nettoyageFichier($titre);
362         say $OUT5 "titre : $texte";
363         $texte=nettoyageFichier($description);
364         say $OUT5 "description : $texte";
365       }
366     }
367     close $OUT5;
368 
369 }
370 
371 
372 
373 #étape 4.2
374 
375 sub nettoyageFichier
376 {
377     my ($texte)= @_;
378     my %hash4=(
379     "&#39;"=>"'",
380     "&lsquo;"=>"'",
381     "&rsquo;"=>"'",
382     "&#38;"=>"&",
383     "&amp;"=>"&",
384     "&#34;"=>"\"",
385     "&quot;"=>"\"",
386     "&#39;"=>"\'",
387     "&apos;"=>"\'",
388     "&#60;"=>"<",
389     "&#62;"=>">",
390     "&#160;"=>" ",
391     "&nbsp;"=>" ",
392     "&#163;"=>"£",
393     "&pound;"=>"£",
394     "&#169;"=>"©",
395     "&#171;"=>"«",
396     "&laquo;"=>"«",
397     "&#187;"=>"»",
398     "&raquo;"=>"",
399     "&#201;"=>"É",
400     "&Eacute;"=>"É",
401     "&#237;"=>"î",
402     "&icirc;"=>"î",
403     "&#239;"=>"ï",
404     "&iuml;"=>"ï",
405     "&#224;"=>"à",
406     "&agrave;"=>"à",
407     "&#226;"=>"â",
408     "&acirc;"=>"â",
409     "&#231;"=>"ç",
410     "&ccedil;"=>"ç",
411     "&#232;"=>"è",
412     "&egrave;"=>"è",
413     "&#233;"=>"é",
414     "&eacute;"=>"é",
415     "&#234;"=>"ê",
416     "&ecirc;"=>"ê",
417     "&#244;"=>"ô",
418     "&ocirc;"=>"ô",
419     "&#251;"=>"û",
420     "&ucirc;"=>"û",
421     "&#252;"=>"ü",
422     "&uuml;"=>"ü",
423     "&uuml;"=>"ü",
424     "&gt;"=>">",
425     "&lt;"=>"<"
426     );
427 
428     foreach my $key (keys %hash4)
429     {
430         $texte=~ s/$key/$hash4{$key}/g;
431     }
432     $texte=enleveBalise($texte);
433     return $texte;
434 }
435 
436 sub headerHtml 
437 {
438 
439     my ($EXIT) =@_;
440 print $EXIT
441 "<html>
442 <head>
443 <meta charset=$encodage
444 </head>
445 <title></title>
446 <body>
447  <table border=\"5\">
448 ";
449 
450 }
451 
452 sub footerHtml
453 {
454     my ($EXIT) =@_;
455 print $EXIT
456 "</table>
457 </body>
458 </html>
459 ";
460 }
461 
462 sub headerXML
463 {
464     my ($OUT)=@_;
465     print $OUT "<?xml version=\"1.0\" encoding=\"$encodage\"?>";
466     print $OUT "<racine>";
467 }
468 
469 sub footerXML
470 {
471     my ($OUT)=@_;
472     print $OUT "</racine>";
473 }
474 
475 
476 sub detectionEncodage
477 {
478 my ($scalaire) = @_;
479 my $encodageFonction;
480 open (my $encodeIN, "<","$scalaire");
481 while (my $ligneEncode = <$encodeIN>)
482 {
483     if ($ligneEncode=~ m/<.xml.*?encoding=(.*?).>/)
484     {
485         $encodageFonction = $1;
486     }
487 }
488 close $encodeIN;
489 $encodageFonction=~ s/'//g;
490 $encodageFonction=~ s/"//g;
491 return $encodageFonction;
492 }
493 
494 sub enleveBalise
495 {
496     my ($ligne)=@_;
497     $ligne=~ s/<img.*?>//g;
498     $ligne=~ s/<br.*?\/>//g;
499     $ligne=~ s/<a.*?\/a>//g;
500     $ligne=~ s/\&/and/g;
501     return $ligne;
502 }
503 
504