perl Mojo和JSON用于同步请求

Question

我通常不是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结果.

帮助将不胜感激!

Answer 1

编辑

似乎我们错过了真正的问题,如何发布表格.哎呀抱歉.

发布表单取决于您使用的Mojolicious版本.直到最近(v3.85 - 2013-02-13)有一种post_form方法.然而,在反思时,决定应该*_form为每种请求类型设置方法,或者我们应该做更聪明的事情,因此form生成器就诞生了.

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

它可以添加到任何请求方法中,使其比旧表单更加一致.另请注意,它应该是hashref,而不是LWP允许的arrayref.BTW还有一个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;
}