[Perl] projet téléchargement pages WEB

wget --help

man wget

#!/usr/bin/perl
use warnings;
use strict;
use LWP::UserAgent;
use HTTP::Cookies;

if (@ARGV != 1) {
	die "Usage: $0 url_de_base\n";
}
my $url_de_base = shift; # recuperation du premier argument du programme

my @liste_urls = ($url_de_base);

my $ua  = LWP::UserAgent->new(
		agent => 'Mozilla/4.73 [en] (X11; I; Linux 2.2.16 i686; Nav)',
		cookie_jar =>
		HTTP::Cookies->new( file => 'cookies.txt', autosave => 1 )
		);

# Expressions régulières pour extraire les liens contenus dans les 
# pages web récoltées
my @expressions = (
		qr/(?:src|href)\s*=\s*('[\']+'|"[\"]+"|[^\s>]*)/i);
my $re = '(?:'. join('|', @expressions) . ')';
print "Expression régulière : $re\n";
my %urls_visitees = ();

my $url;
while($url = shift(@liste_urls)) {
	print "Récupération de $url\n";

	# crée un agent et une requête
	my $req = HTTP::Request->new( GET => $url );

	# récupère la réponse
	my $res = $ua->request($req);
	if (not $res->is_success) {
		warn $res->status_line;
		next;
	}

	my $contenu = $res->content;

	sauve_contenu($url, $contenu);
	$urls_visitees{$url} = 1;
	
	# On ne s'intéresse à l'intérieur du contenu que si c'est du HTML
	# sinon, on passe à l'URL suivante
	next if $res->header( 'Content-Type' ) =~ m#/^text/html#;

	my @urls = $contenu =~ m/$re/go;

	print "URLs récupérées : @urls\n", '-' x 40, "\n";
	@urls = normalise_filtre($url, @urls);
	print "URLs filtrées : @urls\n";

	# On verifie qu'elles n'ont pas deja ete visitees ou ajoutees
	# dans la liste des URLs a visiter
	my @urls_a_ajouter = ();
	foreach (@urls) {
		push @urls_a_ajouter, $_ if !exists $urls_visitees{$_};
	}
	print "URLs à visiter : @urls_a_ajouter\n";

	# Si on décommente la ligne on récupère tout internet
	#push @liste_urls, @urls_a_ajouter;
	
	# Admettons qu'on s'intéresse uniquement aux documents plus 
	# loin dans l'arborescence que l'URL de base
	my ($url_repertoire) = $url_de_base =~ m#^(http://[^/]*(/([^?/]+/)*)?)#i;
	print "Nouvelles URLs à visiter : ";
	foreach (@urls_a_ajouter) {
		if (index($_, $url_repertoire) == 0) {
			push @liste_urls, $_;
			print "$_ ";
		}
	}
	print "\n";
	
}

# Fonction sauve_contenu ($url, $contenu)
# sauvegarde le contenu $contenu de l'URL $url
sub sauve_contenu {
	my ($url, $contenu) = @_;

	my ($serveur, $reste) = $url =~ m#http://([^/]+)(/.*)?#i;
	$serveur =~ s/:\d+$//;# On enlève le port dans le cas toto.com:8080
	$serveur =~ s/.*@//; # On enlève l'utilisateur et le mot de passe dans le cas user:pass@toto.com

	if(!-d $serveur) {
		mkdir $serveur;
	}

	my (@repertoires) = split('/', $reste);

	my $path = $serveur;
	foreach my $rep (@repertoires[1 .. $#repertoires-1]) {
		$path .= '/' . $rep;
		mkdir $path if !-e $path;
	}

	my $fichier = $repertoires[ $#repertoires ];

	if ( (!defined $fichier) or ($fichier eq '/') or ($fichier eq '') ) {
		$fichier = 'index.html';
	}
	if (-d "$path/$fichier") {
		$path .= "/$fichier";
		$fichier = 'index.html';
	}

	open(OUT, ">$path/$fichier") or die "Ouverture en écriture de $path/$fichier : $!";
	print OUT $contenu;
	close OUT;
}

sub normalise_filtre {
	my $base = shift; # Recuperation de l,URL de base pour les URLs relatives
	my ($url_site) = $base =~ m#^(http://[^/]*)#i;
	print "URL du site : $url_site\n";
	my ($url_repertoire) = $base =~ m#^(http://[^/]*(/([^?/]+/)*)?)#i;
	print "URL du répertoire : $url_repertoire\n";
	$url_repertoire .= '/' if $url_site eq $url_repertoire;
	my @urls = ();
	foreach (@_) {
		print "Normalisons $_ : ";
		s/^(['"])(.*)\1$/$2/;
		s/(#.*)$//;
		print "après première moulinette : $_  ";
		if (/^\s*javascript/i){# On saute les liens/scripts javascript
			print "\n";
			next;
		}
		if (/^\s*(.*?)\s*$/) {
			my $url_fragment = $1;

			if (m#^http://#io) {
				push @urls, $url_fragment;
				print "On pousse $url_fragment\n";
				next;
			} elsif (m#^/#o) {
				push @urls, ($url_site . $url_fragment);
				print "On pousse $url_site$url_fragment\n";
			} else {
				push @urls, ($url_repertoire . $url_fragment);
				print "On pousse $url_repertoire$url_fragment\n";
			}
		} else {
			print "Je ne comprends pas ce qu'il y a dans cette URL...";
		}
	}
	return @urls;
}