1 package HTTP
::AnyUA
::Backend
::Net
::Curl
::Easy
;
2 # ABSTRACT: A unified programming interface for Net::Curl::Easy
8 our $VERSION = '0.900'; # VERSION
10 use parent
'HTTP::AnyUA::Backend';
12 use HTTP
::AnyUA
::Util
;
18 my ($method, $url, $args) = @_;
23 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_HTTPGET
(), 0);
24 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_NOBODY
(), 0);
25 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_READFUNCTION
(), undef);
26 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_POSTFIELDS
(), undef);
27 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_POSTFIELDSIZE
(), 0);
29 if ($method eq 'GET') {
30 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_HTTPGET
(), 1);
32 elsif ($method eq 'HEAD') {
33 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_NOBODY
(), 1);
36 if (my $content = $args->{content
}) {
37 if (ref($content) eq 'CODE') {
39 for my $header (keys %{$args->{headers
} || {}}) {
40 if (lc($header) eq 'content-length') {
41 $content_length = $args->{headers
}{$header};
46 if ($content_length) {
48 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_READFUNCTION
(), sub {
53 $chunk = $content->();
57 my $part = substr($chunk, 0, $maxlen, '');
60 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_POSTFIELDSIZE
(), $content_length);
63 # if we don't know the length we have to just read it all in
64 $content = HTTP
::AnyUA
::Util
::coderef_content_to_string
($content);
67 if (ref($content) ne 'CODE') {
68 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_POSTFIELDS
(), $content);
69 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_POSTFIELDSIZE
(), length $content);
73 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_URL
(), $url);
74 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_CUSTOMREQUEST
(), $method);
78 for my $header (keys %{$args->{headers
} || {}}) {
79 my $value = $args->{headers
}{$header};
80 my @values = ref($value) eq 'ARRAY' ? @$value : $value;
82 push @headers, "${header}: $v";
85 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_HTTPHEADER
(), \
@headers) if @headers;
89 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_HEADERFUNCTION
(), sub {
92 my $size = length $data;
94 my %headers = _parse_header
($data);
96 if ($headers{Status
}) {
100 my $resp_headers = $hdrdata[-1];
102 for my $key (keys %headers) {
103 if (!$resp_headers->{$key}) {
104 $resp_headers->{$key} = $headers{$key};
107 if (ref($resp_headers->{$key}) ne 'ARRAY') {
108 $resp_headers->{$key} = [$resp_headers->{$key}];
110 push @{$resp_headers->{$key}}, $headers{$key};
119 my $data_cb = $args->{data_callback
};
121 Scalar
::Util
::weaken
($copy);
122 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_WRITEFUNCTION
(), sub {
126 my $size = length $data;
129 my $resp = $copy->_munge_response(undef, undef, [@hdrdata], $data_cb);
130 $data_cb->($data, $resp);
138 open(my $fileb, '>', \
$resp_body);
139 $ua->setopt(Net
::Curl
::Easy
::CURLOPT_WRITEDATA
(), $fileb);
141 eval { $ua->perform };
144 return $self->_munge_response($ret, $resp_body, [@hdrdata], $data_cb);
148 sub _munge_response
{
155 my %headers = %{pop @$hdrdata || {}};
157 my $code = delete $headers{Status
} || $self->ua->getinfo(Net
::Curl
::Easy
::CURLINFO_RESPONSE_CODE
()) || 599;
158 my $reason = delete $headers{Reason
};
159 my $url = $self->ua->getinfo(Net
::Curl
::Easy
::CURLINFO_EFFECTIVE_URL
());
162 success
=> 200 <= $code && $code <= 299,
166 headers
=> \
%headers,
169 my $version = delete $headers{HTTPVersion
} || _http_version
($self->ua->getinfo(Net
::Curl
::Easy
::CURLINFO_HTTP_VERSION
()));
170 $resp->{protocol
} = "HTTP/$version" if $version;
172 # We have the headers for the redirect chain in $hdrdata, but we don't have the contents, and we
173 # would also need to reconstruct the URLs.
176 my $err = $self->ua->strerror($error);
177 return HTTP
::AnyUA
::Util
::internal_exception
($err, $resp);
180 $resp->{content
} = $body if $body && !$data_cb;
185 # get the HTTP version according to the user agent object
188 return $version == Net
::Curl
::Easy
::CURL_HTTP_VERSION_1_0
() ? '1.0' :
189 $version == Net
::Curl
::Easy
::CURL_HTTP_VERSION_1_1
() ? '1.1' :
190 $version == Net
::Curl
::Easy
::CURL_HTTP_VERSION_2_0
() ? '2.0' : '';
193 # parse a header line (or status line) and return as key-value pairs
197 $data =~ s/[\x0A\x0D]*$//;
199 if ($data =~ m!^HTTP/([0-9.]+) [\x09\x20]+ (\d{3}) [\x09\x20]+ ([^\x0A\x0D]*)!x) {
207 my ($key, $val) = split(/:\s*/, $data, 2);
209 return (lc($key) => $val);
212 # no Net::Curl::Easy;
224 HTTP::AnyUA::Backend::Net::Curl::Easy - A unified programming interface for Net::Curl::Easy
232 This module adds support for the HTTP client L<Net::Curl::Easy> to be used with the unified
233 programming interface provided by L<HTTP::AnyUA>.
241 The C<redirects> field in the response is currently unsupported.
251 L<HTTP::AnyUA::Backend>
257 Please report any bugs or feature requests on the bugtracker website
258 L<https://github.com/chazmcgarvey/HTTP-AnyUA/issues>
260 When submitting a bug or request, please include a test-file or a
261 patch to an existing test-file that illustrates the bug or desired
266 Charles McGarvey <chazmcgarvey@brokenzipper.com>
268 =head1 COPYRIGHT AND LICENSE
270 This software is copyright (c) 2017 by Charles McGarvey.
272 This is free software; you can redistribute it and/or modify it under
273 the same terms as the Perl 5 programming language system itself.