view release on metacpan or  search on metacpan

lib/AnyEvent/HTTP/LWP/UserAgent.pm  view on Meta::CPAN

sub post {
    return shift->post_async(@_)->recv;
}

sub head {
    return shift->head_async(@_)->recv;
}

sub put {
    return shift->put_async(@_)->recv;
}

sub delete {
    return shift->delete_async(@_)->recv;
}

sub lwp_request2anyevent_request {
    my ($self, $in_req) = @_;

    my $method = $in_req->method;
    my $uri = $in_req->uri->as_string;

    if ($self->cookie_jar) {
        $self->cookie_jar->add_cookie_header($in_req);
    }

    my $in_headers = $in_req->headers;
    my $out_headers = {};
    $in_headers->scan( sub {
        my ($header, $value) = @_;
        $out_headers->{$header} = $value;
    } );

    # if we will use some code like
    #    local $AnyEvent::HTTP::USERAGENT = $useragent;
    # in simple_request, it will not work properly in redirects
    $out_headers->{'User-Agent'} = $self->agent;

    my $body;
    if(ref($in_req->content) eq 'CODE') {
        # Minimum coderef support
        # TODO: Add chunked transfer but maybe necessary to modify AnyEvent::HTTP itself
        $body = '';
        while(my $ret = $in_req->content->()) {
            $body .= $ret;
            last if $ret eq '';
        }
    } else {
        $body = $in_req->content;
    }

    my %args = (
        headers => $out_headers,
        body    => $body,
        recurse => 0, # because LWP call simple_request as much as needed
        timeout => $self->timeout,
    );
    if ($self->conn_cache) {
        $args{persistent} = 1;
        $args{keepalive} = 1;
    } else {
        # By default AnyEvent::HTTP set persistent = 1 for idempotent
        # requests. So just for compatibility with LWP::UserAgent we
        # disable this options.
        $args{persistent} = 0;
        $args{keepalive} = 0;
    }
    return ($method, \$uri, \%args);
}

sub request_async
{
    my($self, $request, $arg, $size, $previous) = @_;

    my $cv = AE::cv;
    $self->simple_request_async($request, $arg, $size)->cb(sub {
    my $response = shift->recv;
    $response->previous($previous) if $previous;

    if ($response->redirects >= $self->{max_redirect}) {
        $response->header("Client-Warning" =>
                          "Redirect loop detected (max_redirect = $self->{max_redirect})");
        $cv->send($response); return;
    }

    if (my $req = $self->run_handlers("response_redirect", $response)) {
        $self->request_async($req, $arg, $size, $response)->cb(sub { $cv->send(shift->recv) }); return;
    }

    my $code = $response->code;

    if ($code == &HTTP::Status::RC_MOVED_PERMANENTLY or
	$code == &HTTP::Status::RC_FOUND or
	$code == &HTTP::Status::RC_SEE_OTHER or
	$code == &HTTP::Status::RC_TEMPORARY_REDIRECT)
    {
	my $referral = $request->clone;

	# These headers should never be forwarded
	$referral->remove_header('Host', 'Cookie');

	if ($referral->header('Referer') &&
	    $request->uri->scheme eq 'https' &&
	    $referral->uri->scheme eq 'http')
	{
	    # RFC 2616, section 15.1.3.
	    # https -> http redirect, suppressing Referer
	    $referral->remove_header('Referer');
	}

	if ($code == &HTTP::Status::RC_SEE_OTHER ||
	    $code == &HTTP::Status::RC_FOUND)
        {
	    my $method = uc($referral->method);
	    unless ($method eq "GET" || $method eq "HEAD") {
		$referral->method("GET");
		$referral->content("");
		$referral->remove_content_headers;
	    }
	}

	# And then we update the URL based on the Location:-header.
	my $referral_uri = $response->header('Location');
	{
	    # Some servers erroneously return a relative URL for redirects,
	    # so make it absolute if it not already is.