2012-12-16 9 views
3

최소한의 웹 크롤러를 작성하려고합니다. 목표는 시드에서 새 URL을 검색하고 이러한 새 URL을 더 크롤링하는 것입니다. 다음과 같이 코드는 : 나는 더 이상 진행 수있는 방법재귀 웹 크롤러 perl

use strict; 
use warnings; 
use Carp; 
use Data::Dumper; 
use WWW::Mechanize; 

my $url = "http://foobar.com"; # example 
my %links; 

my $mech = WWW::Mechanize->new(autocheck => 1); 
$mech->get($url); 
my @cr_fronteir = $mech->find_all_links(); 

foreach my $links (@cr_fronteir) { 
    if ($links->[0] =~ m/^http/xms) { 
     $links{$links->[0]} = $links->[1]; 
    } 
} 

내가 여기에 붙어있다가, % 링크의 링크를 크롤링 또한, 어떻게 내가 오버 플로우를 방지하기 위해 깊이를 추가 할 수 있습니다. 제안을 환영합니다.

답변

4

함수를 만들지 않고 재귀를 사용할 수 없습니다.

use strict; 
use warnings; 
use Carp; #unused, but I guess yours was a sample 
use Data::Dumper; 
use WWW::Mechanize; 

my %links; 
my $mech = WWW::Mechanize->new(autocheck => 1); 

sub crawl { 
    my $url = shift; 
    my $depth = shift or 0; 
    #this seems like a good place to assign some form of callback, so you can 
    # generalize this function 

    return if $depth > 10; #change as needed 

    $mech->get($url); 
    my @cr_fronteir = $mech->find_all_links(); 

    #not so sure what you're trying to do; before, $links in the 
    # foreach overrides the global %links 
    #perhaps you meant this...? 
    foreach my $link (@cr_fronteir) { 
     if ($link->[0] =~ m/^http/xms) { 
      $links{$link->[0]} = $link->[1]; 

      #be nice to servers - try not to overload them 
      sleep 3; 
      #recursion! 
      crawl($link->[0], depth+1); 
     } 
    } 
} 

crawl("http://foobar.com", 0); 

이 파티션에는 Perl이 설치되어 있지 않으므로 구문 오류 및 기타 장난이 발생하기 쉽지만 기본으로 사용할 수 있습니다.

첫 번째 함수 주석에서 설명한대로 매핑 기능을 하드 코딩하는 대신 콜백을 전달하고 크롤링하는 모든 링크에 대해 호출하여 기능을 일반화 할 수 있습니다.

0

일부 의사 코드 :

while (scalar @links) { 
    my $link = shift @links; 
    process_link($link); 
} 

sub process_link { 
    my $link = shift; 

    $mech->get($link); 
    foreach my $page_link ($mech->find_all_links()) { 
     next if $links{$page_link}; 
     $links{$page_links} = 1; 
     push @links, $page_link; 
    } 
} 

P. S. /m/s 수정이 (너무와 /x) 코드에서 필요하지 않습니다.

+0

/m,/s 및/x 플래그 : 다양한 Perl 스타일 가이드가 각 정규식에 이들을 배치하는 것이 좋습니다./x는/x가 너무 유용하기 때문에// ms는 일부 초보자 친화적이지 않은 정규 표현식 동작을 변경합니다 .-- 나는 또한 항상 정규 표현식에이 정규 표현식에 3 개의 플래그를 추가해야합니다. –

5

Mojolicious 웹 프레임 워크는 웹 크롤러에 대한 유용한 몇 가지 흥미로운 기능을 제공하지 : 펄 V5.10 제외

  • 없음 종속 이상
  • URL 파서
  • DOM 트리 파서
  • 비동기 HTTP/HTTPS 클라이언트를 (오버 헤드없이 fork()의 동시 요청을 허용)

다음은 재귀 적으로 로컬 Apache 문서를 크롤링하고 페이지 제목과 추출 된 링크를 표시하는 예입니다. 그것은 4 개 병렬 연결을 사용하여보다 깊은 3 개 경로 수준, 한 번만 각 추출 된 링크를 방문 이동하지 않습니다 팁을 & 트릭의 I Don’t Need No Stinking API: Web Scraping For Fun and Profit 기사를 읽으을 긁어 더 많은 웹 들어

#!/usr/bin/env perl 
use 5.010; 
use open qw(:locale); 
use strict; 
use utf8; 
use warnings qw(all); 

use Mojo::UserAgent; 

# FIFO queue 
my @urls = (Mojo::URL->new('http://localhost/manual/')); 

# User agent following up to 5 redirects 
my $ua = Mojo::UserAgent->new(max_redirects => 5); 

# Track accessed URLs 
my %uniq; 

my $active = 0; 

sub parse { 
    my ($tx) = @_; 

    # Request URL 
    my $url = $tx->req->url; 

    say "\n$url"; 
    say $tx->res->dom->at('html title')->text; 

    # Extract and enqueue URLs 
    for my $e ($tx->res->dom('a[href]')->each) { 

     # Validate href attribute 
     my $link = Mojo::URL->new($e->{href}); 
     next if 'Mojo::URL' ne ref $link; 

     # "normalize" link 
     $link = $link->to_abs($tx->req->url)->fragment(undef); 
     next unless $link->protocol =~ /^https?$/x; 

     # Don't go deeper than /a/b/c 
     next if @{$link->path->parts} > 3; 

     # Access every link only once 
     next if ++$uniq{$link->to_string} > 1; 

     # Don't visit other hosts 
     next if $link->host ne $url->host; 

     push @urls, $link; 
     say " -> $link"; 
    } 

    return; 
} 

sub get_callback { 
    my (undef, $tx) = @_; 

    # Parse only OK HTML responses 
    $tx->res->code == 200 
     and 
    $tx->res->headers->content_type =~ m{^text/html\b}ix 
     and 
    parse($tx); 

    # Deactivate 
    --$active; 

    return; 
} 

Mojo::IOLoop->recurring(
    0 => sub { 

     # Keep up to 4 parallel crawlers sharing the same user agent 
     for ($active .. 4 - 1) { 

      # Dequeue or halt if there are no active crawlers anymore 
      return ($active or Mojo::IOLoop->stop) 
       unless my $url = shift @urls; 

      # Fetch non-blocking just by adding 
      # a callback and marking as active 
      ++$active; 
      $ua->get($url => \&get_callback); 
     } 
    } 
); 

# Start event loop if necessary 
Mojo::IOLoop->start unless Mojo::IOLoop->is_running; 

합니다.