File Coverage

blib/lib/LWP/UserAgent/POE.pm

Criterion	Covered	Total	%
statement	79	82	96.3
branch	2	4	50.0
condition			n/a
subroutine	18	19	94.7
pod	2	5	40.0
total	101	110	91.8

###########################################
package LWP::UserAgent::POE;
###########################################

use strict;
use warnings;

our $VERSION = "0.05";
use LWP::UserAgent;
use base "LWP::UserAgent";

use warnings;
use strict;
use POE;
use POE::Component::Client::HTTP;
use HTTP::Request;
use Log::Log4perl qw(:easy);

#use Scalar::Defer;

###########################################
sub new {
###########################################
    my ($class, %options) = @_;

    my $default_options = LWP::UserAgent->new( %options );
    delete $default_options->{proxy};

    my $self = bless {
        await_id => 0,
        poco_alias => "lwp_useragent_poe_http_client_poco",
        %$default_options,
        %options,
    }, $class;

    DEBUG "Creating $self->{poco_alias} session";

    POE::Session->create(
        object_states => [
            $self => {
                on_response => '_poe_handle_response',
                on_request  => '_poe_handle_request',
                on_shutdown => '_poe_handle_shutdown',
                _start => '_poe_handle_startup',
            }
        ],
    );

    $self->spawn();

    return $self;
}

###########################################
sub spawn {
###########################################
    my($self) = @_;

    if( $poe_kernel->alias_resolve( $self->{poco_alias} ) ){
        DEBUG "Not spawning $self->{poco_alias}",
              " session (there's one already)";
        return 1;
    }

    DEBUG "Spawning $self->{poco_alias} POE HTTP client component";

    POE::Component::Client::HTTP->spawn(
        Alias           =>  $self->{poco_alias},
        $self->poco_options(),
    );
}

###########################################
sub poco_options {
###########################################
    my($self) = @_;

    # agent                   "libwww-perl/#.##"
    # from                    undef
    # conn_cache              undef
    # cookie_jar              undef
    # default_headers         HTTP::Headers->new
    # max_size                undef
    # max_redirect            7
    # parse_head              1
    # protocols_allowed       undef
    # protocols_forbidden     undef
    # requests_redirectable   [’GET’, ’HEAD’]
    # timeout                 180

    my %lwp2poco = (
        agent      => "Agent",
        from       => "From",
        timeout    => "Timeout",
        max_size   => "MaxSize",
        cookie_jar => "CookieJar",
        proxy      => "Proxy",
        noproxy    => "NoProxy",
        redirects  => "FollowRedirects",
    );

    my %poco_options = ();

    for my $lwp_opt (keys %lwp2poco) {
        if(exists $lwp2poco{ $lwp_opt } ) {
            $poco_options{ $lwp2poco{ $lwp_opt } } =
                $self->{ $lwp_opt };
        }
    }

    return %poco_options;
}

###########################################
sub _poe_handle_startup {
###########################################
    $_[KERNEL]->alias_set("$_[OBJECT]");
}

###########################################
sub _poe_handle_shutdown {
###########################################
    $_[KERNEL]->alias_remove("$_[OBJECT]");
}

###########################################
sub simple_request {
###########################################
    my ($self, $request) = @_;

    INFO "Received request ", $request->url();

    $self->prepare_request( $request );

    my $promise = \my $scalar;
    $poe_kernel->post("$self", on_request => $request, $promise);
    $self->await( $promise, $request );
    return $$promise;

    # maybe we'll add that later to stack up requests before
    # processing them.
    # lazy { $$promise or $self->await($promise); $$promise };
}

###########################################
sub _poe_handle_request {
###########################################
    my ($self, $kernel, $request, $promise) = @_[OBJECT, KERNEL, ARG0, ARG1];

    DEBUG "Handling request ", $request->url();

    $kernel->post($self->{poco_alias} =>
                  request => on_response => $request, $promise);
}

###########################################
sub _poe_handle_response {
###########################################
    my ($self, $request_info, $response_info) = @_[OBJECT, ARG0, ARG1];

    DEBUG "Handling response ", $request_info->[0]->url();

    my $promise = $request_info->[1];
    my $response = $response_info->[0];

    my $promise_number = $promise + 0;
    $$promise = $response;

    my $await_id = delete $self->{awaiting}{$promise_number};
    delete $self->{promises}{$await_id}{$promise_number};
}

###########################################
sub await {
###########################################
    my ($self, $promise, $request) = @_;

    DEBUG "Awaiting ", $request->url();

    my $await_id = $self->{await_id}++;

    my $promise_number = $promise+0;
    $self->{promises}{$await_id}{$promise_number} = $promise;
    $self->{awaiting}{$promise_number} = $await_id;

    while (keys %{$self->{promises}{$await_id}}) {
        $poe_kernel->run_one_timeslice();
    }

    INFO "Response from ", $request->url(), " arrived (",
         $$promise->code(), ")";

    delete $self->{promises}{$await_id};
}

1;

__END__