3

我通常不是 Perl 编码器。但是我必须完成这个任务。

以下代码适用于我：

#!/usr/bin/perl

use LWP::UserAgent;
use JSON;
use strict;

my $md5 = $ARGV[0];
$md5 =~ s/[^A-Fa-f0-9 ]*//g;
die "invalid MD5" unless ( length($md5) == 32 );

my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 1 }, timeout => 10);
my $key="12345...7890";
my $url='https://www.virustotal.com/vtapi/v2/file/report';
my $response = $ua->post( $url, ['apikey' => $key, 'resource' => $md5] );
die "$url error: ", $response->status_line unless $response->is_success;
my $results=$response->content;

my $json = JSON->new->allow_nonref;
my $decjson = $json->decode( $results);

print "md5: ",$md5,"\n";
print "positives: ", $decjson->{"positives"}, "\n";
print "total: ", $decjson->{"total"}, "\n";
print "date: ", $decjson->{"scan_date"}, "\n";

现在我想重新编码上面的代码，以便使用 Mojo 使用异步 http。我正在尝试这个：

#!/usr/bin/perl

use warnings;
use strict;
use Mojo;
use Mojo::UserAgent;

my $md5 = $ARGV[0];
$md5 =~ s/[^A-Fa-f0-9 ]*//g;
die "invalid MD5" unless ( length($md5) == 32 );

my ($vt_positives, $vt_scandate, $response_vt);
my $url='https://www.virustotal.com/vtapi/v2/file/report';
my $key="12345...7890";
my $ua = Mojo::UserAgent->new;
my $delay = Mojo::IOLoop->delay;

$ua->max_redirects(0)->connect_timeout(3)->request_timeout(6);
$ua->max_redirects(5);
$delay->begin;

$response_vt = $ua->post( $url => ['apikey' => $key, 'resource' => $md5] => sub {
    my ($ua, $tx) = @_;
    $vt_positives=$tx->res->json->{"positives"};
    print "Got response: $vt_positives\n";
    });

Mojo::IOLoop->start unless Mojo::IOLoop->is_running;

第一个代码可以，第二个代码不起作用。我在发送请求时一定做错了，因为我似乎收到了 403 响应（API 使用不正确）。我也尝试过 -> json 调用，但没有成功。

即使我正确完成了请求，我也不确定我是否使用 Mojo 正确解码了 json 结果。

帮助将不胜感激！

4

3 回答 3

5

编辑

似乎我们错过了真正的问题，即如何发布表单。哎呀对不起。

发布表格取决于您使用的 Mojolicious 版本。直到最近（v3.85 -- 2013-02-13）还有一种post_form方法。然而，经过反思，我们决定要么应该*_form为每种请求类型提供方法，要么我们应该做一些更聪明的事情，因此form生成器诞生了。

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

它可以添加到任何请求方法中，使其比旧形式更加一致。另请注意，它应该是 hashref，而不是 LWP 允许的 arrayref。顺便说一句，还有一个json像这样工作的生成器，或者你甚至可以添加你自己的！

我将留下我原来的答案，显示非阻塞用法，您现在可以根据上述内容进行修改。

原来的

从 creaktive 建立逻辑，这就是我要开始的方式。主要区别在于没有监视器在监视以确保有工作进行，而是在完成时检查以确保没有闲人。

我也在解析逻辑上做了一些改变，但没什么大不了的。

#!/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;
}
于 2013-03-01T21:07:37.733 回答
0

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 )

您在 ref 中的第一个脚本中提供的数组格式“\@form”

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

因为它是一个散列，所以最好用散列格式“\%form”编写

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

在 Mojo::UserAgent 中，要发布的参数稍微复杂一些，但本质上似乎是哈希键的哈希引用的“字符串”，我对此并不熟悉。但是，您可能会发现使用 hash ref 格式正确地提供了预期的参数。

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 {... });
于 2013-03-01T13:35:55.513 回答
0

看看我写的这个基于 Mojolicious 的并发请求网络爬虫来说明我的文章Web Scraping with Modern 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;
}
于 2013-03-01T18:09:14.593 回答