#!/usr/bin/perl #bibliothèques perl à uitiliser use strict; use locale; use LWP::Simple; use Encode; use HTML::Entities; #demande à l'utilisateur le chemin du répertoire où sont stockées les urls print "Entrer le chemin du dossier contenant les urls\n"; #stockage dans une variable du chemin du répertoire où sont stockées les urls my $urls =; #suppression des éventuels retours à la ligne chomp($urls); #demande à l'utilisateur le chemin où stocker le tableau en html print "Entrer le chemin du tableau html\n"; my $tablo =; #supression des éventuels retours chariots chomp($tablo); #avertissement de fonctionnement du programme print "programme en cours...\n"; #ouverture du fichier html en écriture if (! -e $tablo) { open(SORTIE,">$tablo.html"); #début du code html print SORTIE ("tableaux de liens"); print SORTIE ("\n"); #ouverture du répertoire contenant les urls opendir (REP, $urls) or die "impossible d'ouvrir le repertoire"; #lister le fichiers txt contenus dans le répertoire my @mot =grep !/^\./,readdir (REP); #Pour chaque fichier de la liste de fichiers txt foreach my $mottxt (@mot) { #créer un compteur my $c=0; #Recherche de l'emplacement du point de l'extension du fichier txt my $point=index($mottxt,'.'); #stockage dans une variable de la partie avant le point my $mot=substr($mottxt,0,$point); #stockage dans une variable du chemin d'accès aux urls my $fichier="$urls/$mottxt"; #création d'une liste vide pour stocker les lignes de chaque fichier my @lignes = (); #ouverture du fichier en lecture open (FIC, "<$fichier") || die "fichier non trouve\n"; #pour chaque ligne du fichier while() { #stocker les lignes dans une liste push(@lignes,$_); } #Ecriture des entêtes du tableau html print SORTIE (""); print SORTIE ("\n"); #pour chaque ligne dans la liste des lignes foreach my $ligne (@lignes) { #Incrémentation du compteur $c=$c+1; #stockage des pages aspirées dans un fichier html my $page_aspiree = "PAGES-ASPIREES/$mot$c.html"; #Ouverture du fichier de pages aspirées open(PAGES,">$page_aspiree"); #stockage des pages de contexte dans un fichier txt my $contexte="./CONTEXTES/$mot$c.txt"; #ouverture du fichier de contexte en écriture open (CONT, ">$contexte")|| die "fichier non trouve\n" ; #aspiration et stockage des urls. message d'erreur le cas échéant getstore("$ligne","$page_aspiree"); my $page = get( "$ligne" ); if ( not defined($page) ) { $page="La page n'a pas pu être aspirée"; print PAGES ("La page n'a pas pu être aspiree"); } #Détection encodage des urls #par défault on affecte à $encodage_page la valeur "latin1" my $encodage_page = "latin1"; if ($page =~ /\bcharset\s*=\s*([\w-]+)/i) { $encodage_page = $1; } #on cherche a savoir si la page est deja en utf8 ou non avec un booleen my $testutf8 = utf8::is_utf8($page); #création variable vide my $page_unicode=(); #si utf8 if ($testutf8) { $page_unicode = $page; } #sinon recodage en utf8 else { $page_unicode = decode( $encodage_page, $page ); } #Nettoyage de la page my $texte_unicode = supprime_html( $page_unicode ); #Normalisation des caractères my $texte = normalise_latin1( $texte_unicode ); #procédure de suppression sub supprime_html { my @balises_a_ignorer = ("applet","code","embed","head","object","script","server"); my $html = shift @_; $html =~ s/\n+/ /g; $html =~ s/\r+/ /g; decode_entities($html); foreach my $balise (@balises_a_ignorer) { $html=~s/<$balise.*?<\/$balise>//ig; } $html =~ s///g; #commentaires $html =~ s/<\/?p\/?>/\n/ig; #paragraphes $html =~ s//\n/ig; #retours à la ligne $html =~ s/<\/tr>/\n/ig; #lignes de tableau $html =~ s/<\/?h[1-6]>/\n/ig; #titres $html =~ s/<\/?div.*?>/\n/ig; #sections $html =~ s/<.*?>//g; #autres balises $html =~ s/\s*\n\s*/\n/g; #espaces en début/fin de ligne $html =~ s/ +/ /g; #séquences de plusieurs espaces return $html; } #procédure de normalisation sub normalise_latin1 { my $chaine = shift @_; $chaine =~ s/[\x{2019}\x{2018}]/\'/g; $chaine =~ s/[\x{201C}\x{201D}]/\"/g; $chaine =~ s/[\x{2013}\x{2014}]/-/g; $chaine =~ s/\x{2026}/.../g; $chaine =~ s/\x{0152}/OE/g; $chaine =~ s/\x{0153}/oe/g; $chaine =~ s/[^\x{0000}-\x{00FF}]//g; return $chaine; } #stockage des dumps my $dump="DUMPS-UTF8/$mot$c.txt"; #ouverture du fichier dump en écriture open(DUM,">$dump"); #stockage du texte nettoyé et normalisé print DUM ("$texte"); #Fermeture du fichier dump close(DUM); #création d'une variable vide my @lignes = (); #on ouvre à nouveau le fichier $dump mais cette fois à la lecture avec < open (DUM, "<$dump") || die "fichier non trouve\n"; #tant qu'il y a des lignes dans le fichier: while () { #liste de toutes les lignes du fichier push(@lignes,$_); } #ouverture du fichier de contexte open (CONT, ">$contexte")|| die "fichier non trouve\n" ; #pour chaque ligne de la liste foreach my $line (@lignes) { #couper le texte en mot et le mettre dans une liste my @mots = split /[\s']/,$line; #création d'un compteur de mots my $compt=0; #pour chaque mot de la liste foreach my $word (@mots) { #si le mot est égal au mot if ($word eq $mot) { #prendre les contextes gauche et droite du mot print CONT ("$mots[$compt-3] $mots[$compt] $mots[$compt+3] "); } #incrémenter le compteur de mots $compt=$compt+1; } } #on ferme le fichier de contexte close (CONT); #Remplir le tableau html print SORTIE (""); print SORTIE ("\n"); #effacer la page my $page = (); #fermeture de la page close(PAGES); } #fermeture du fichier txt contenant les urls close(FIC); } #saut de ligne print SORTIE ("

"); #fermeture du tableau print SORTIE ("
Tableau $mot
url n° $cpage aspiree n° $cdump utf-8 n° $ccontexte n° $c
"); #fermeture du fichier html contenant le tableau close(SORTIE); #avertissement utilisateur de fin print "Fin du programme\n"; print "Le tableau html est maintenant disponible\n"; #fermeture du répertoire d'urls closedir(REP); }