Web-Crawler mit Perl

Question

Ich möchte einen Web-Crawler entwickeln, der von einer Seed-URL startet und dann 100 html-Seiten durchsucht, die zur selben Domäne gehören wie die Seed-URL sowie einen Datensatz der durchsuchten URLs enthält, die Duplikate vermeiden. Ich habe folgendes geschrieben, aber der Wert von $ url_count scheint nicht inkrementiert zu sein, und die abgerufenen URLs enthalten sogar Links von anderen Domains. Wie löse ich das? Hier habe ich stackoverflow.com als meine Start-URL eingefügt.

use strict; 
use warnings; 

use LWP::Simple; 
use LWP::UserAgent; 
use HTTP::Request; 
use HTTP::Response; 


##open file to store links 
open my $file1,">>", ("extracted_links.txt"); 
select($file1); 

##starting URL 
my @urls = 'http://stackoverflow.com/'; 

my $browser = LWP::UserAgent->new('IE 6'); 
$browser->timeout(10); 
my %visited; 
my $url_count = 0; 


while (@urls) 
{ 
    my $url = shift @urls; 
    if (exists $visited{$url}) ##check if URL already exists 
    { 
     next; 
    } 
    else 
    { 
     $url_count++; 
    }   

    my $request = HTTP::Request->new(GET => $url); 
    my $response = $browser->request($request); 

    if ($response->is_error()) 
    { 
     printf "%s\n", $response->status_line; 
    } 
    else 
    { 
     my $contents = $response->content(); 
     $visited{$url} = 1; 
     @lines = split(/\n/,$contents); 
     foreach $line(@lines) 
     { 
      $line =~ m@(((http\:\/\/)|(www\.))([a-z]|[A-Z]|[0-9]|[/.]|[~]|[-_]|[()])*[^'">])@g; 
      print "$1\n"; 
      push @urls, $$line[2]; 
     } 

     sleep 60; 

     if ($visited{$url} == 100) 
     { 
      last; 
     } 
    } 
} 

close $file1; 

Answer 1

Mehrere Punkte, Ihre URL-Analyse ist fragil, Sie werden sicherlich keine relativen Links bekommen. Außerdem testet ihr nicht 100 Links, sondern 100 Matches der aktuellen URL, was mit Sicherheit nicht das ist, was ihr meint. Schließlich bin ich mit LWP nicht so vertraut, also werde ich ein Beispiel mit der Mojolicious Suite von Werkzeugen zeigen.

Dies scheint zu funktionieren, vielleicht wird es Ihnen einige Ideen geben.

#!/usr/bin/env perl 

use strict; 
use warnings; 

use Mojo::UserAgent; 
use Mojo::URL; 

##open file to store links 
open my $log, '>', 'extracted_links.txt' or die $!; 

##starting URL 
my $base = Mojo::URL->new('http://stackoverflow.com/'); 
my @urls = $base; 

my $ua = Mojo::UserAgent->new; 
my %visited; 
my $url_count = 0; 

while (@urls) { 
    my $url = shift @urls; 
    next if exists $visited{$url}; 

    print "$url\n"; 
    print $log "$url\n"; 

    $visited{$url} = 1; 
    $url_count++;   

    # find all <a> tags and act on each 
    $ua->get($url)->res->dom('a')->each(sub{ 
    my $url = Mojo::URL->new($_->{href}); 
    if ($url->is_abs) { 
     return unless $url->host eq $base->host; 
    } 
    push @urls, $url; 
    }); 

    last if $url_count == 100; 

    sleep 1; 
}