view release on metacpan or  search on metacpan

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

    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.
	    local $URI::ABS_ALLOW_RELATIVE_SCHEME = 1;
	    my $base = $response->base;
	    $referral_uri = "" unless defined $referral_uri;
	    $referral_uri = $HTTP::URI_CLASS->new($referral_uri, $base)
		            ->abs($base);
	}
	$referral->uri($referral_uri);

	if($self->redirect_ok($referral, $response)) {
	    $self->request_async($referral, $arg, $size, $response)->cb(sub{ $cv->send(shift->recv) }); return;
	} else {
	    $cv->send($response); return;
	}

    }
    elsif ($code == &HTTP::Status::RC_UNAUTHORIZED ||
	     $code == &HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED
	    )
    {
	my $proxy = ($code == &HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED);
	my $ch_header = $proxy ?  "Proxy-Authenticate" : "WWW-Authenticate";
	my @challenge = $response->header($ch_header);
	unless (@challenge) {
	    $response->header("Client-Warning" =>
			      "Missing Authenticate header");
	    $cv->send($response); return;
	}

	require HTTP::Headers::Util;
	CHALLENGE: for my $challenge (@challenge) {
	    $challenge =~ tr/,/;/;  # "," is used to separate auth-params!!
	    ($challenge) = HTTP::Headers::Util::split_header_words($challenge);
	    my $scheme = shift(@$challenge);
	    shift(@$challenge); # no value