Przeszukiwacz sieci WWW używający perl

Question

Chcę utworzyć przeszukiwacz sieciowy, który rozpoczyna się od adresu URL źródłowego, a następnie przemierza 100 stron HTML, które znajduje należące do tej samej domeny co adres URL źródłowej, a także przechowuje rekord adresów URL z pominięciem duplikatów. Napisałem następujące informacje, ale wartość $ url_count nie wydaje się być inkrementowana, a pobierane adresy URL zawierają łącza nawet z innych domen. Jak rozwiązać ten problem? Tutaj wstawiłem stackoverflow.com jako mój początkowy adres URL.

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

Kilka punktów, parsowanie adresów URL jest kruche, na pewno nie otrzymasz względnych linków. Nie testujesz również 100 linków, ale 100 dopasowań aktualnego adresu URL, co prawie na pewno nie jest tym, co masz na myśli. Wreszcie, nie jestem zbyt obeznany z LWP, więc zamierzam pokazać przykład używając zestawu narzędzi Mojolicious.

To wydaje się działać, może da ci kilka pomysłów.

#!/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; 
}