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;

最初のコードは問題ありませんが、2 番目のコードは機能しません。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 { ... }
);

任意のリクエスト メソッドに追加できるため、古い形式よりもはるかに一貫性が保たれます。また、LWP で許可されている配列参照ではなく、ハッシュ参照であることにも注意してください。ところで、このように機能するジェネレーターもあります。または、独自のジェネレーターを追加する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 to array 形式 "\@form" で提供するもの

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

これはハッシュであるため、おそらくハッシュ形式 "\%form" で記述したほうがよいでしょう。

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

Mojo::UserAgent では、post する引数はもう少し複雑ですが、基本的にはハッシュ リファレンスからハッシュ キーへの "文字列" のように見えますが、これには慣れていません。ただし、ハッシュ参照形式を使用すると、期待される引数が正しく提供される場合があります。

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

私が記事Web Scraping with Modern Perlを説明するために書いた、この同時要求 Mojolicious ベースの Web クローラーを見てください。

#!/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 に答える