#!/usr/bin/perl 

#on appelle les différentes librairies utilisées par le script
use strict;
use locale;
use LWP::Simple;
use Encode;
use HTML::Entities;

#on demande à l'utilisateur où sont stockées les urls
print "Entrer un chemin de répertoire\n";
#on réserve une variable $url pour enregister la réponse de l'utilisateur
my $url =<STDIN>;
#le programme enregistre la réponse
chomp($url);
#on affiche le contenu de la variable $url
print $url;
#on effectue les mêmes opérations mais cette fois on demande à l'utilisateur où stocker le tableau final
print "ou stocker le tableau?\n";
my $tablo =<STDIN>;
chomp($tablo);
#ouverture du fichier html contenant le tableau de lien
if (! -e $tablo)
{
		open(SORTIE,">$tablo.html");


#Tout d'abord on insère le code html pour créer le début de la page web avec le code css pour la personnaliser
print SORTIE ("<html><head><title>tableau de liens</title><style type=\"text/css\">table,th,td {border: 1px solid #333333;text-align: center;} th,td{color:#333333} a {color:#615E39} </style></head><center><body>");
print SORTIE ("\n");

#Cette variable permettra l'indication du n° des pages créées pour les liens, les dumps et les contextes
my $p=1;
#ouverture du répertoire contenant les url
opendir (REP1, $url) or die "impossible d'ouvrir le repertoire";
#lecture des entrees d'un repertoire, chaque sous répertoire est représentée par une ligne dans la liste @sens
my @sens =grep !/^\./,readdir (REP1);
print @sens;
#pour chaque entrée du répertoire lire les entrées (par sens) et les afficher
foreach my $entree (@sens)
		{
			#on crée une variable $sens qui contient le chemin d'accès vers les répertoires
			#pour chaque sens: linguistique, informatique, naturel et socio-culturel
			#à chaque tour de boucle on se trouvera dans un répertoire différent
			my $sens = "$url/$entree\n";
			#on affiche la variable $sens pour vérifier que la boucle fonctionne bien
			print $sens;
			#Ici, le code html crée le titre du tableau et la première ligne avec le libelé des colonnes
			print SORTIE ("<table cellspacing=0><CAPTION><i><font size=14 color=#76C363>$entree</font><i></CAPTION><tr BGCOLOR=#39ACA8><th>SENS</th><th>LIENS</th><th>PAGES ASPIREES</th><th>DUMP</th><th>CONTEXTES</th></tr>");
			print SORTIE ("\n");
			#ouverture du répertoire contenant les fichier pour chaque sens
			opendir (REP2, $sens) or die "impossible d'ouvrir le répertoire";
			#récupération sous forme de liste du contenu de REP2
			my @langue =grep !/^\./,readdir (REP2);
			#pour chaque fichier contenu dans la liste @langue, les instructions suivantes seront effectuées:
			foreach my $languetxt (@langue)
				{
					#initialise le compteur du nombre de page qui vont être aspirées pour savoir quelle dimension donner au tableau
					my $l=0;
					#on va récupèrer le nom de la langue sans l'extension txt
					#il faut d'abord calculer l'emplacement du . dans la chaîne de caractère dans la variable $languetxt
					my $point=index($languetxt,'.');
					#puis on crée la variable langue en utilisant la variable languetxt et en ne gardant que ce qui va du premier caractère au .
					my $langue=substr($languetxt,0,$point);
					#affiche la variable langue
					print "$langue\n";
					#on initialise une variable vide pour enregister le motif à chercher dans les pages web
					my $motif =();
					#si la langue est "français"
					if ($langue eq "français")
					{
					#le motif est environnement
					$motif = "environnement";
					}
					#sinon dans les deux autres cas (espagnol et portugais)
					else
					{
					#le motif est ambiente
					$motif = "ambiente";
					}
					
					#on donne le chemin d'accès(qui varie en fonction de $url, $entre et $languetxt) 
					#des fichiers dans lequels sont stockés les url 
					my $fichier="$url/$entree/$languetxt";
					#on initialise une liste vide qui va contenir le contenu des lignes de de chaque fichier languetxt
					my @lignes = ();
					#on ouvre le fichier languetxt pour la lecture avec le chevron <
					open (FIC, "<$fichier") || die "fichier non trouvé\n"; 
					#tant qu'il y a des lignes dans le fichier on exécute les instructions
					while(<FIC>)
					{
					#on envoie le contenu de la ligne $_ dans la liste @lignes
					 push(@lignes,$_);
					#on incrémente la variable $l avant le tour de boucle suivant	
					 $l=$l+1;
					}
					#on remplit la première colonne de notre tableau (fichier identifié par le nom SORTIE). 
					print SORTIE ("<tr><td rowspan=$l BGCOLOR=#C1D559><b>$langue<b></td>");
					print SORTIE ("\n");
					#pour chaque valeur de la liste @lignes qui vient d'être construite, on exécute le bloc d'instructions:
					foreach my $var (@lignes)
					{	#on crée une variable qui permettra de stocker les pages aspirées dans un fichier .html
						my $page_aspi = "perl/PAGES-ASPIREES/$entree$langue$p.html";
						#on ouvre ce fichier pour l'écriture avec le chevron >
						open(PAGES,">$page_aspi");
						#on indique dans la variable $ resul o$ l'on stockera les fichiers de contexte
						my $resul="./perl/RESULTAT/$entree$langue$p.txt";
						#on ouvre le fichier de contexte en écriture avec >
						open (FIC3, ">$resul")|| die "fichier non trouvé\n" ;
						#getstore permet d'aspirer les pages et de les enregistrer directement dans le fichier $page_aspi
						getstore("$var","$page_aspi");
						#la fonction get permet d'aspirer les pages $var et de les stocker dans la variable $page 
						#pour tavailler dessus sans les enregistrer dans un fichier
						my $page = get( "$var" );
						#si la page n'a pas été aspirée, un message d'érreur s'affiche
						if ( not defined($page) )
							{
							print "Problème lors du téléchargement !\n";
							#on affecte dans la variable un message d'erreur qui sera affiché 
							#à la place du contenu de la page (dans le dump)
							$page="La page n'a pas pu être aspirée";
							#on affiche le même message dans le fichier page aspirée
							print PAGES ("La page n'a pas pu être aspirée");
							}
						
						#cette partie du script (qui nettoye les pages) a été réalisée avec l'aide d'un script trouvé
						#sur le site http://perl.linguistes.free.fr/progs/URL-texte.pl
						#nous l'avons adapté à notre script
						#on va ici repérer l'encodage de la page
						#par défault on affecte à $encodage_page la valeur "latin1"
						my $codage_page = "latin1";
						if ($page =~ /\bcharset\s*=\s*([\w-]+)/i) 
							{
							$codage_page = $1; 
							#dans $1 est sauvegardé le contenu de la première parenthèse de l'expression régulière
							}	

						# on cherche a savoir si la page est deja en utf8 ou non avec un booleen
						my $testutf8 = utf8::is_utf8($page);
						#on initialise une variable vide pour enregistrer le contenu de la page en unicode
						my $page_unicode=();
						#si on est déjà un utf8, on n'a pas besoin de décoder la page
							if ($testutf8) 
							{
							print "on est en utf8 pas de decodage necessaire\n";
							$page_unicode = $page;
							}
						#sinon on va recoder à l'aide de la fonction decode (à l'aide de la bibliothèque Enccode 
						#qui est appelée au début du script
						else {
							print "on est pas en utf8, il faut donc decoder\n";
							$page_unicode = decode( $codage_page, $page );
							}
						
						#on utilise ici les sous programmes supprime html (pour supprimer les balises, retours à la lignes...)
						my $texte_unicode = supprime_html( $page_unicode );
						#on utilise le sous programme normalise_latin1, pour normailiser les caractères
						my $texte = normalise_latin1( $texte_unicode );
						
						#on intègre ici les sous-programmes à utiliser
						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/<br\/?>/\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;
							}

						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;
							}
						
					#on indique maintenant le chemin d'accès pour stocker les dumps
					my $dump="perl/DUMP/$entree$langue$p.txt";
					#on ouvre le fichier $dump à l'écriture avec >
					open(TEXTE,">$dump");
					#on le remplit avec la variable $texte qui contient les pages aspirée nettoyées à l'aide de nos sous-programmes
					print TEXTE ("$texte");	
					#on ferme le fichier
					close(TEXTE);
					#on initialise une liste vide pour stocker le contenu des lignes
					my @ligne = ();
					#on ouvre à nouveau le fichier $dump mais cette fois à la lecture avec <
					open (TEXTE, "<$dump") || die "fichier non trouvé\n"; 
					#tant qu'il y a des lignes dans le fichier:
					while (<TEXTE>)
					{
					#on enregistre le contenu $_ de la ligne dans la liste @ligne
					#on obtient donc une liste contenant toutes les lignes du fichier
					push(@ligne,$_);	
					}
					
					#on ouvre le fichier $résul (initialisé plus haut) à l'écriture
					open (FIC3, ">$resul")|| die "fichier non trouvé\n" ;
					#pour chaque ligne de la liste @ligne on fait:						
					foreach my $lin (@ligne)
					{
					#avec la fonction split, on découpe les mots de chaque ligne
					#on obtient dans la liste @mots la liste des mots 
					my @mots = split /[\s']/,$lin;            
					#on affiche la liste des mots
					print "$_\n" for @mots;
					#on initialise un conteur qui va permettre de savoir à quel mot on se situe dans la liste @mots
					my $nbre=0;
					#pour chaque mot de la liste @mots:
						foreach my $m (@mots)
						{	#si le mot est égal au motif
							if ($m eq $motif)
							{ 	#on va copier le mot identifié par son idice dans la liste de mots ($mots[$nbre])
								#ainsi que son contexte gauche($mots[$nbre-2]) et droit ($mots[$nbre+2]) dans le fichier de contexte
								#on peur choisir le nombre de mots que l'on veut avoir dans le contexte gauche et droit 
								#on choisit ici deux prendre deux mots à gauche et deux mots à droite
								print FIC3 ("$mots[$nbre-2] $mots[$nbre] $mots[$nbre+2] ");
							}
						#à la fin du tour de boucle on incrémente la variable $nbre pour passer au mot suivant
						$nbre=$nbre+1;
						}

					}
					#on ferme le fichier de contexte
					close (FIC3);
					# On edite le code HTML permettant de créer les colonnes du tableau avec les liens
					print SORTIE ("<td><a href=\"$var\">lien n° $p</a></td><td><a href=\"./PAGES-ASPIREES/$entree$langue$p.html\">page n° $p</a></td><td><a href=\"./DUMP/$entree$langue$p.txt\">dump n° $p</a></td><td><a href=\"./RESULTAT/$entree$langue$p.txt\">contexte n° $p</a></td></tr>");
					print SORTIE ("\n");
					#on incrémente $p pour passer à la page suivante
					$p=$p+1;
					#on vide la page
					my $page = ();
					#on ferme la page
					close(PAGES);
				}
				#on ferme le fichier de langue pour passer au suivant
				close(FIC);
			}
		#on effectue un saut de ligne dans notre tableau pour passer au fichier suivant		
		print SORTIE ("<br><br>");
		}
#on ferme le tableau
print SORTIE ("</table></center></body></html>");
#on ferme le fichier html contenant le tableau
close(SORTIE);
#on ferme le répertoire contenant les fichiers par sens
closedir(REP1);
#on ferme le répertoire url
closedir(REP2);
}