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>.
9 If installed, requests will return L<AnyEvent::Future> rather than L<Future>. This allows the use of
10 the C<< ->get >> method to await a result.
15 * L<HTTP::AnyUA::Backend>
22 our $VERSION = '9999.999'; # VERSION
24 use parent
'HTTP::AnyUA::Backend';
27 use HTTP
::AnyUA
::Util
;
32 $future_class = 'Future';
33 eval 'use AnyEvent::Future'; ## no critic
34 $future_class = 'AnyEvent::Future' if !$@;
40 $backend->options(\
%options);
42 Get
and set
default arguments to C
<http_request
>.
46 sub options
{ @_ == 2 ? $_[0]->{options
} = pop : $_[0]->{options
} }
48 sub response_is_future
{ 1 }
52 my ($method, $url, $args) = @_;
54 my %opts = $self->_munge_request($method, $url, $args);
55 my $future = $future_class->new;
57 require AnyEvent
::HTTP
;
58 AnyEvent
::HTTP
::http_request
($method => $url, %opts, sub {
59 my $resp = $self->_munge_response(@_, $args->{data_callback
});
61 if ($resp->{success
}) {
77 my $args = shift || {};
79 my %opts = %{$self->options || {}};
81 if (my $headers = $args->{headers
}) {
84 for my $header (keys %$headers) {
85 my $value = $headers->{$header};
86 $value = join(', ', @$value) if ref($value) eq 'ARRAY';
87 $headers{$header} = $value;
89 $opts{headers
} = \
%headers;
92 my @url_parts = HTTP
::AnyUA
::Util
::split_url
($url);
93 if (my $auth = $url_parts[4] and !$opts{headers
}{'authorization'}) {
94 # handle auth in the URL
96 $opts{headers
}{'authorization'} = 'Basic ' . MIME
::Base64
::encode_base64
($auth, '');
99 my $content = HTTP
::AnyUA
::Util
::coderef_content_to_string
($args->{content
});
100 $opts{body
} = $content if $content;
102 if (my $data_cb = $args->{data_callback
}) {
103 # stream the response
104 $opts{on_body
} = sub {
106 $data_cb->($data, $self->_munge_response(undef, @_));
114 sub _munge_response
{
120 # copy headers because http_request will continue to use the original
121 my %headers = %$headers;
123 my $code = delete $headers{Status
};
124 my $reason = delete $headers{Reason
};
125 my $url = delete $headers{URL
};
128 success
=> 200 <= $code && $code <= 299,
132 headers
=> \
%headers,
135 my $version = delete $headers{HTTPVersion
};
136 $resp->{protocol
} = "HTTP/$version" if $version;
138 $resp->{content
} = $data if $data && !$data_cb;
141 my $redirect = delete $headers{Redirect
};
143 # delete pseudo-header first so redirects aren't recursively munged
144 my $next = delete $redirect->[1]{Redirect
};
145 unshift @redirects, $self->_munge_response(@$redirect);
148 $resp->{redirects
} = \
@redirects if @redirects;
150 if (590 <= $code && $code <= 599) {
151 HTTP
::AnyUA
::Util
::internal_exception
($reason, $resp);