1 package HTTP
::AnyUA
::Backend
::AnyEvent
::HTTP
;
2 # ABSTRACT: A unified programming interface for AnyEvent::HTTP
6 This module adds support for the HTTP client L<AnyEvent::HTTP> to be used with the unified
7 programming interface provided by L<HTTP::AnyUA>.
12 * L<HTTP::AnyUA::Backend>
19 our $VERSION = '9999.999'; # VERSION
21 use parent
'HTTP::AnyUA::Backend';
24 use HTTP
::AnyUA
::Util
;
29 $backend->options(\
%options);
31 Get
and set
default arguments to C
<http_request
>.
35 sub options
{ @_ == 2 ? $_[0]->{options
} = pop : $_[0]->{options
} }
37 sub response_is_future
{ 1 }
41 my ($method, $url, $args) = @_;
43 my %opts = $self->_munge_request($method, $url, $args);
44 my $future = Future-
>new;
46 require AnyEvent
::HTTP
;
47 AnyEvent
::HTTP
::http_request
($method => $url, %opts, sub {
48 my $resp = $self->_munge_response(@_, $args->{data_callback
});
50 if ($resp->{success
}) {
66 my $args = shift || {};
68 my %opts = %{$self->options || {}};
70 if (my $headers = $args->{headers
}) {
73 for my $header (keys %$headers) {
74 my $value = $headers->{$header};
75 $value = join(', ', @$value) if ref($value) eq 'ARRAY';
76 $headers{$header} = $value;
78 $opts{headers
} = \
%headers;
81 my @url_parts = HTTP
::AnyUA
::Util
::split_url
($url);
82 if (my $auth = $url_parts[4] and !$opts{headers
}{'authorization'}) {
83 # handle auth in the URL
85 $opts{headers
}{'authorization'} = 'Basic ' . MIME
::Base64
::encode_base64
($auth, '');
88 my $content = HTTP
::AnyUA
::Util
::coderef_content_to_string
($args->{content
});
89 $opts{body
} = $content if $content;
91 if (my $data_cb = $args->{data_callback
}) {
93 $opts{on_body
} = sub {
95 $data_cb->($data, $self->_munge_response(undef, @_));
103 sub _munge_response
{
109 # copy headers because http_request will continue to use the original
110 my %headers = %$headers;
112 my $code = delete $headers{Status
};
113 my $reason = delete $headers{Reason
};
114 my $url = delete $headers{URL
};
117 success
=> 200 <= $code && $code <= 299,
121 headers
=> \
%headers,
124 my $version = delete $headers{HTTPVersion
};
125 $resp->{protocol
} = "HTTP/$version" if $version;
127 $resp->{content
} = $data if $data && !$data_cb;
130 my $redirect = delete $headers{Redirect
};
132 # delete pseudo-header first so redirects aren't recursively munged
133 my $next = delete $redirect->[1]{Redirect
};
134 unshift @redirects, $self->_munge_response(@$redirect);
137 $resp->{redirects
} = \
@redirects if @redirects;
139 if (590 <= $code && $code <= 599) {
140 HTTP
::AnyUA
::Util
::internal_exception
($reason, $resp);