perl Mojo и JSON для одновременных запросов

ИЗМЕНИТЬ

Кажется, мы упустили настоящий вопрос, как публиковать формы. Ой извините за это.

Формы публикации зависят от того, какую версию Mojolicious вы используете. До недавнего времени (v3.85 -- 13 февраля 2013 г.) был post_form методом. Однако, поразмыслив, было решено, что либо для каждого типа запроса должно быть *_form метода, либо мы должны сделать что-то более разумное, и, таким образом, form генератор родился.

$response_vt = $ua->post( 
  $url, 
  form => {'apikey' => $key, 'resource' => $md5}, 
  sub { ... }
);

Его можно добавить к любому методу запроса, что сделает его гораздо более согласованным, чем старая форма. Также обратите внимание, что это должен быть hashref, а не arrayref, как позволяет LWP. Кстати, есть также генератор json, который работает так же, или вы даже можете добавь свой!

Я оставляю свой первоначальный ответ, показывающий неблокирующее использование, которое вы теперь можете изменить, учитывая вышеизложенное.

ОРИГИНАЛ

Опираясь на логику креатива, я бы начал так. Основное отличие состоит в том, что нет монитора, наблюдающего за тем, идут ли работы, а когда кто-то заканчивает, он проверяет, чтобы убедиться, что нет бездельников.

Я также внес некоторые изменения в логику синтаксического анализа, но ничего серьезного.

#!/usr/bin/env perl
use Mojo::Base -strict;
use utf8::all;

use Mojo::URL;
use Mojo::UserAgent;

# FIFO queue
my @urls = qw(
    http://sysd.org/page/1/
    http://sysd.org/page/2/
    http://sysd.org/page/3/
);

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

start_urls($ua, \@urls, \&get_callback);

sub start_urls {
  my ($ua, $queue, $cb) = @_;

  # Limit parallel connections to 4
  state $idle = 4;
  state $delay = Mojo::IOLoop->delay(sub{say @$queue ? "Loop ended before queue depleated" : "Finished"});

  while ( $idle and my $url = shift @$queue ) {
    $idle--;
    print "Starting $url, $idle idle\n\n";

    $delay->begin;

    $ua->get($url => sub{ 
      $idle++; 
      print "Got $url, $idle idle\n\n"; 
      $cb->(@_, $queue); 

      # refresh worker pool
      start_urls($ua, $queue, $cb); 
      $delay->end; 
    });

  }

  # Start event loop if necessary
  $delay->wait unless $delay->ioloop->is_running;
}

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

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

    # Request URL
    my $url = $tx->req->url;
    say "Processing $url";
    parse_html($url, $tx, $queue);
}

sub parse_html {
    my ($url, $tx, $queue) = @_;

    state %visited;

    my $dom = $tx->res->dom;
    say $dom->at('html title')->text;

    # Extract and enqueue URLs
    $dom->find('a[href]')->each(sub{

        # Validate href attribute
        my $link = Mojo::URL->new($_->{href});
        return unless eval { $link->isa('Mojo::URL') };

        # "normalize" link
        $link = $link->to_abs($url)->fragment(undef);
        return unless grep { $link->protocol eq $_ } qw(http https);

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

        # Access every link only once
        return if $visited{$link->to_string}++;

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

        push @$queue, $link;
        say " -> $link";
    });
    say '';

    return;
}

Взгляните на этот параллельный поисковый робот на основе Mojolicious, который я написал для иллюстрации своей статьи Скрапинг веб-страниц с помощью современного Perl:

#!/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 = map { Mojo::URL->new($_) } qw(
    http://sysd.org/page/1/
    http://sysd.org/page/2/
    http://sysd.org/page/3/
);

# Limit parallel connections to 4
my $max_conn = 4;

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

# Keep track of active connections
my $active = 0;

Mojo::IOLoop->recurring(
    0 => sub {
        for ($active + 1 .. $max_conn) {

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

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

    # Deactivate
    --$active;

    # Parse only OK HTML responses
    return
        if not $tx->res->is_status_class(200)
        or $tx->res->headers->content_type !~ m{^text/html\b}ix;

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

    say $url;
    parse_html($url, $tx);

    return;
}

sub parse_html {
    my ($url, $tx) = @_;

    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 grep { $link->protocol eq $_ } qw(http https);

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

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

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

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

    return;
}

LWP::UserAgent принимает аргументы для публикации либо в виде ссылки на массив, либо в формате ссылки на хэш.

http://search.cpan.org/~gaas/libwww-perl-6.04/lib/LWP/UserAgent.pm#REQUEST_METHODS

$ua->post( $url, \%form )
$ua->post( $url, \@form )

который вы предоставляете в первом скрипте в формате ссылки на массив "\@form"

my $response = $ua->post( $url, ['apikey' => $key, 'resource' => $md5] );

так как это хэш, вероятно, лучше писать в формате хэша "\%form"

my $response = $ua->post( $url, {'apikey' => $key, 'resource' => $md5} );

В Mojo::UserAgent аргументы для публикации немного сложнее, но, по сути, представляют собой «строку» хэш-ссылок на хэш-ключи, с которыми я не знаком. Однако вы можете обнаружить, что использование формата хэш-ссылки правильно обеспечивает ожидаемые аргументы.

http://search.cpan.org/~sri/Mojolicious-3.87/lib/Mojo/UserAgent.pm#post

POST

my $tx = $ua->post('kraih.com');
my $tx = $ua->post('http://kraih.com' => {DNT => 1} => 'Hi!');
my $tx = $ua->post('http://kraih.com' => {DNT => 1} => form => {a => 'b'});
my $tx = $ua->post('http://kraih.com' => {DNT => 1} => json => {a => 'b'});

попробуй это ?:

$response_vt = $ua->post( $url => form => {'apikey' => $key, 'resource' => $md5} => sub {... });