3

最小限の Web クローラーを作成しようとしています。目的は、シードから新しい URL を発見し、これらの新しい URL をさらにクロールすることです。コードは次のとおりです。

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];
    }
}

ここで立ち往生しています。%links のリンクをさらにクロールするにはどうすればよいですか。また、オーバーフローを防ぐために深さを追加するにはどうすればよいですか。提案をお待ちしております。

4

3 に答える 3

5

Mojolicious Web フレームワークは、Web クローラーに役立ついくつかの興味深い機能を提供します。

  • Perl v5.10 以降以外の依存関係なし
  • URL パーサー
  • DOM ツリー パーサー
  • fork()非同期 HTTP/HTTPS クライアント (オーバーヘッドなしで同時要求を許可)

以下は、ローカルの Apache ドキュメントを再帰的にクロールし、ページ タイトルと抽出されたリンクを表示する例です。4 つの並列接続を使用し、3 つのパス レベルよりも深くはならず、抽出された各リンクに 1 回だけアクセスします。

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

その他の Web スクレイピングのヒントとコツについては、I Don't Need No Stinking API: Web Scraping For Fun and Profitの記事を参照してください。

于 2012-12-16T13:22:23.587 に答える
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 がインストールされていないため、構文エラーやその他の問題が発生しやすくなりますが、基礎として役立つ可能性があります。

最初の関数のコメントで述べたように、マッピング機能をハードコーディングする代わりに、関数にコールバックを渡し、クロールするすべてのリンクに対してそれを呼び出すことで、関数を一般化してより大きな栄光を得ることができます。

于 2012-12-16T09:24:56.500 に答える
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;
    }
}

PS/mと/s修飾子は、コードでは不要です (そしてそれ/xも)。

于 2012-12-16T09:27:25.177 に答える