How to have perl web crawler do 'breadth first' retrieval, like wget?

user_327528 0
Viewed 135

I have written a basic web crawler in perl. How can I make it more sophisticated by having it do the retrieval in a 'breadth first' manner, like wget does?

This is from the wget docs:

Recursive retrieval of HTTP and HTML/CSS content is breadth-first. This means that Wget first downloads the requested document, then the documents linked from that document, then the documents linked by them, and so on. In other words, Wget first downloads the documents at depth 1, then those at depth 2, and so on until the specified maximum depth.

Any comments about my code would also be appreciated.

use feature 'say';
use WWW::Mechanize;
use List::MoreUtils 'any';

##############
# parameters #
##############
my $url = "https://www.crawler-test.com/"; # starting url
my $depth_level = 2; # depth level for crawling (level 1 will only look at links on the starting page)
my $filter = ".pdf"; # for multiple types use this format: ".pdf|.docx|.doc|.rtf"
my $wait = 2; # wait this number of seconds between http requests (be kind to the server)
my $domain = ""; # only crawl links with host ending in this string, leave blank if not required. For multiple domains, use this format: "domain1|domain2"
my $nocrawlagain = 1; # setting this to 1 will mean that the same link will not be crawled again, set to 0 to turn this off
##############


$domain = quotemeta($domain);
$domain =~ s/\\\|/|/g;

my @linkscrawled;

open LOG, ">mecherrors.log";
LOG->autoflush;

my $mech = WWW::Mechanize->new(stack_depth => 0, onerror => \&mecherror);

sub crawl {

    my $url = shift;
    my $filter = shift;
    my $depth = shift || 1;

    return if $depth > $depth_level;

    say "Crawling $url";
    $mech->get($url);
    sleep $wait;
    return unless ($mech->success and $mech->is_html);


    my @linkstocrawl;

    for $link ($mech->find_all_links(url_abs_regex => qr/^http/))  # only get http links (excludes things like mailto:)
    {

        next if $link->url =~ /#/;  # excludes URLs that are referring to an anchor

        # if the link matches the filter then download it
        if ($link->url =~ /($filter)$/)
        {
            my $urlfilename = ($link->URI->path_segments)[-1];
            next if -e $urlfilename;
            $mech->get($url); # go to base page
            sleep $wait;
            $mech->get($link->url);
            sleep $wait;
            my $filename = $mech->response->filename;
            next if -e $filename;
            $mech->save_content($filename);
            say "Saved $filename";

        } else {

            push @linkstocrawl, $link;

        }
    }

    for $link (@linkstocrawl)
    {
        next unless $link->url_abs->host =~ /($domain)$/;
        if ($nocrawlagain)
        {
            # skip if already crawled this link
            next if any { $_ eq $link->url_abs->abs } @alreadycrawled;
            push @alreadycrawled, $link->url_abs->abs;
        }
        crawl($link->url_abs->abs, $filter, $depth + 1);
    }

}


crawl($url, $filter);

sub mecherror {
    print LOG "[", $mech->uri, "] ", $mech->response->message, "\n";
}
web-crawler wget perl
2 Answers

If you want to do breadth-first, you need to take the my @linkstocrawl declaration out of sub crawl so that there's just one master to-do list rather than a separate list for each invocation of the crawling sub.

It will also be easier to do breadth-first if you make the code non-recursive, because recursion lends itself to depth-first more-or-less automatically. (When you recursively call a sub to handle a section of the search space, that sub won't return until that section is completely finished, which isn't what you want for breadth-first.)

So the general structure you'd want is something like (not complete or tested code):

my @linkstocrawl = $starting_url;
my %linkscrawled; # hash instead of array for faster/easier lookups

while (my $url = shift @linkstocrawl) {
  next if exists $linkscrawled{$url}; # already saw it, so skip it
  $linkscrawled{$url}++;

  my $page = fetch($url);
  push @linkstocrawl, find_links_on($page);
  # you could also push the links onto @linkstocrawl one-by-one, depending on
  # whether you prefer to parse the page incrementally or grab them all at once

  # Do whatever else you want to do with $page
}
Nomad_Dervish_189140

The difference between a depth-first search (DFS) and a breadth-first search (BFS) is quite simple:

  • A DFS uses a to-do stack.

    my @todo = ...;
while (@todo) {
   my $job = pop(@todo);
   push @todo, process($job);
}

  • A BFS uses a to-do queue.

    my @todo = ...;
while (@todo) {
   my $job = shift(@todo);
   push @todo, process($job);
}

Recursion is a technique that takes advantage of a stack of execution states. This is why a recursive search routine will perform a depth-first search. You will need to eliminate the recursive calls to crawl.

Each request requires two pieces of information: The URL to request, and the depth of the page. The elements of our to-do list will consist of these two-part task definitions.

Using the above for guidance, the following is the desired overall flow of the code:

my @todo = [ $starting_url, 0 ];
my %urls_seen = map { $_ => 1 } $start_url;

while (@todo) {
   my ($url, $depth) = @{ shift(@todo) };

   my $response = fetch($url);

   # Optionally do something with $response.

   my $linked_depth = $depth+1;
   if ($linked_depth <= $max_depth) {
      push @todo,
         map [ $_, $linked_depth ],
            grep !$urls_seen{$_}++,
               find_links($response);
   }

   # Optionally do something with $response.
}

By the way, you should prevent the UA from following redirects automatically (requests_redirectable => []) to avoid downloading a page you've previously downloaded.

user_5899240
Related