recursive web crawler perl

Question

I am trying to write a minimal web crawler. The aim is to discover new URLs from the seed and crawl these new URLs further. The code is as follows:

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

I am stuck here, how could I proceed further to crawl the links in %links and also, how do I add depth to prevent overflow. Suggestion are appreciated.

Answer 1

Mojolicious web framework offer some interesting features useful for web crawlers:

• No dependencies except Perl v5.10 or later
• URL parser
• DOM tree parser
• Asynchronous HTTP/HTTPS client (allows concurrent requests with no fork() overhead)

Here is an example which recursively crawls a local Apache documentation and displays page titles and extracted links. It uses 4 parallel connections and doesn't goes deeper than 3 path levels, visiting each extracted link only once:

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

For more web scraping tips & tricks, read the I Don’t Need No Stinking API: Web Scraping For Fun and Profit article.