Веб-искатель с использованием perl

Question

Я хочу разработать веб-искатель, который начинается с URL-адреса семян, а затем сканирует 100 html-страниц, которые он находит, принадлежащих к тому же домену, что и начальный URL-адрес, а также ведет запись обходных URL-адресов, избегая дубликатов. Я написал следующее, но значение $ url_count, похоже, не увеличивается, а найденные URL-адреса содержат ссылки даже из других доменов. Как я могу это решить? Здесь я вставил stackoverflow.com в качестве исходного 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

Несколько точек, ваш анализ URL-адресов является хрупким, вы, конечно же, не получите относительных ссылок. Также вы не проверяете 100 ссылок, кроме 100 совпадений текущего URL, что почти наверняка не означает, что вы имеете в виду. Наконец, я не слишком хорошо знаком с LWP, поэтому я приведу пример с помощью набора инструментов Mojolicious.

Это, кажется, работает, возможно, это даст вам некоторые идеи.

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