Perl Curl Multi的使用

最新推荐文章于 2025-06-06 19:15:21 发布

iteye_14303

最新推荐文章于 2025-06-06 19:15:21 发布

阅读量153

点赞数

CC 4.0 BY-SA版权

分类专栏：网站开发文章标签： Perl Web

本文链接：https://blog.youkuaiyun.com/iteye_14303/article/details/81815090

网站开发专栏收录该内容

8 篇文章

订阅专栏

本文介绍了一种使用Perl语言结合CURLMulti库实现单进程多连接的WEB访问方法。通过自定义类UrlFetcher，该方法能够高效地进行并发请求处理，并提供回调函数以灵活应对不同场景需求。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

Perl利用CURL Multi实现单进程多连接的WEB访问

#!/usr/bin/perl -w

use strict;
use warnings;
use WWW::Curl::Easy;
use WWW::Curl::Multi;

package UrlFetcher;
sub new {
    my $option = shift || {};
    $option->{MAX_CONN} = 2 unless defined($option->{MAX_CONN});
    $option->{CONNECT_TIMEOUT} = 15 unless defined($option->{CONNECT_TIMEOUT});
    $option->{READ_TIMEOUT} = 25 unless defined($option->{READ_TIMEOUT});
    $option->{CB_URL} = sub{} unless defined($option->{CB_URL});
    $option->{CB_RET} = sub{} unless defined($option->{CB_RET});
    $option->{CB_WAIT} = sub {sleep(1)} unless defined($option->{CB_WAIT});
    my $curls = {};
    for (my $i = 1; $i < $option->{MAX_CONN} + 1; $i++) {
        $curls->{$i} = WWW::Curl::Easy->new();
    }
    bless {
        OPTION => $option,
        CURLM => WWW::Curl::Multi->new(),
        IDLE_CURLS => $curls,
        BUSY_CURLS => {},
    }
}

sub DESTROY {
    my $pkg = shift;
    foreach my $i (keys(%{$pkg->{IDLE_CURLS}})) {
        delete $pkg->{IDLE_CURLS}->{$i};
    }
    foreach my $i (keys(%{$pkg->{BUSY_CURLS}})) {
        delete $pkg->{BUSY_CURLS}->{$i};
    }
    delete $pkg->{CURLM};
}

sub _prepareCurl {
    my $pkg = shift;
    my $active_handles = 0;

    foreach my $i (keys(%{$pkg->{IDLE_CURLS}})) {
        my $req = &{$pkg->{OPTION}->{CB_URL}}();
        if (defined($req) && $req) {
            my $curl = $pkg->{IDLE_CURLS}->{$i};
            delete $pkg->{IDLE_CURLS}->{$i};
            my $data = {CURL=>$curl, REQ=>$req};
            $data->{REQ}->{HTTP_CODE} = 0;
            $data->{REQ}->{HTTP_BODY} = '';
            open (my $fileb, ">", \$req->{HTTP_BODY});
            $curl->setopt(WWW::Curl::Easy::CURLOPT_WRITEDATA,$fileb);
            $curl->setopt(WWW::Curl::Easy::CURLOPT_HEADER, 0);
            $curl->setopt(WWW::Curl::Easy::CURLOPT_CONNECTTIMEOUT, $pkg->{OPTION}->{CONNECT_TIMEOUT});
            $curl->setopt(WWW::Curl::Easy::CURLOPT_TIMEOUT, $pkg->{OPTION}->{READ_TIMEOUT});
            $curl->setopt(WWW::Curl::Easy::CURLOPT_URL, $req->{HTTP_URL});
            $curl->setopt(WWW::Curl::Easy::CURLOPT_PRIVATE,$i);
            $pkg->{BUSY_CURLS}->{$i} = $data;
            $pkg->{CURLM}->add_handle($curl);
            $active_handles++;
        }else {
            last;
        }
    }
    return $active_handles;
}

sub __processResult {
    my $pkg = shift;
    my $data = shift;

    &{$pkg->{OPTION}->{CB_RET}}($data);
}

sub perform {
    my $pkg = shift;
    my $active_handles = 0;
    my $pending_handles = $pkg->_prepareCurl();
    $active_handles += $pending_handles;
    while ($active_handles) {
        my $active_transfers = $pkg->{CURLM}->perform();
        if ($active_transfers != $active_handles) {
            while (my ($id,$return_value) = $pkg->{CURLM}->info_read()) {
                if ($id) {
                    $active_handles--;
                    my $data = $pkg->{BUSY_CURLS}->{$id};
                    delete $pkg->{BUSY_CURLS}->{$id};
                    $data->{REQ}->{RET} = $return_value;
                    $data->{REQ}->{HTTP_CODE} = $data->{CURL}->getinfo(WWW::Curl::Easy::CURLINFO_HTTP_CODE);
                    $pkg->__processResult($data->{REQ});
                    $pkg->{IDLE_CURLS}->{$id} = $data->{CURL};
                }
            }
        }
        $pending_handles = $pkg->_prepareCurl();
        &{$pkg->{OPTION}->{CB_WAIT}}() unless ($pending_handles);
        $active_handles += $pending_handles;
        die("bad items of easy curl") unless ($pkg->{OPTION}->{MAX_CONN} == scalar(keys(%{$pkg->{IDLE_CURLS}})) + scalar(keys(%{$pkg->{BUSY_CURLS}})));
    }
}

1;
__END__

=head1 DOCUMENTATION

use UrlFetcher;
$i = 0;
sub cb_url {
    my $ret = undef;
    $i++;
    $ret = {HTTP_URL => 'http://192.168.2.150/lht/lht.txt?idx='.$i, IDX => $i, MY_VALUE => '000',};
    sleep(5) unless ($i % 20);
    return $ret;
}

sub cb_ret {
    my $d = shift;
    print 'INDEX: '. $d->{IDX}. "\n";
    print 'MY VALUE: '. $d->{MY_VALUE}. "\n";
    print 'RET CODE: '. $d->{RET}. "\n";
    if ($d->{RET}) {
        print "RET MSG: BAD\n";
    } else {
        print "RET MSG: OK\n";
    }
    print 'HTTP CODE: '. $d->{HTTP_CODE}. "\n";
    print 'HTTP BODY: '. $d->{HTTP_BODY}. "\n";
}

sub cb_wait {
    sleep(1);
}

my $opt = {MAX_CONN=>10,
           CONNECT_TIMEOUT=>25,
           READ_TIMEOUT=>35,
           CB_URL=>\&cb_url,
           CB_RET=>\&cb_ret,
           CB_WAIT=>\&cb_wait,
           };
my $fetcher = UrlFetcher::new($opt);
$fetcher->perform();