Dogcows Code - chaz/p5-HTTP-AnyUA/blob - lib/HTTP/AnyUA/Backend/Furl.pm

   1 package HTTP::AnyUA::Backend::Furl;
   2 # ABSTRACT: A unified programming interface for Furl
   3
   4 =head1 DESCRIPTION
   5
   6 This module adds support for the HTTP client L<Furl> to be used with the unified programming
   7 interface provided by L<HTTP::AnyUA>.
   8
   9 =head1 CAVEATS
  10
  11 =for :list
  12 * L<Furl> doesn't keep a list of requests and responses along a redirect chain. As such, the C<url>
  13 field in the response is always the same as the URL of the original request, and the C<redirects>
  14 field is never used.
  15
  16 =head1 SEE ALSO
  17
  18 =for :list
  19 * L<HTTP::AnyUA::Backend>
  20
  21 =cut
  22
  23 use warnings;
  24 use strict;
  25
  26 our $VERSION = '9999.999'; # VERSION
  27
  28 use parent 'HTTP::AnyUA::Backend';
  29
  30 use HTTP::AnyUA::Util;
  31
  32
  33 sub request {
  34     my $self = shift;
  35     my ($method, $url, $args) = @_;
  36
  37     local $args->{content} = HTTP::AnyUA::Util::coderef_content_to_string($args->{content});
  38
  39     my $request = HTTP::AnyUA::Util::native_to_http_request(@_);
  40     my $ua_resp = $self->ua->request($request);
  41
  42     return $self->_munge_response($ua_resp, $args->{data_callback});
  43 }
  44
  45 sub _munge_response {
  46     my $self    = shift;
  47     my $ua_resp = shift;
  48     my $data_cb = shift;
  49
  50     my $resp = {
  51         success => !!$ua_resp->is_success,
  52         url     => $ua_resp->request->uri->as_string,
  53         status  => $ua_resp->code,
  54         reason  => $ua_resp->message,
  55         headers => HTTP::AnyUA::Util::http_headers_to_native($ua_resp->headers),
  56     };
  57
  58     $resp->{protocol} = $ua_resp->protocol if $ua_resp->protocol;
  59
  60     if ($resp->{headers}{'x-internal-response'}) {
  61         HTTP::AnyUA::Util::internal_exception($ua_resp->content, $resp);
  62     }
  63     elsif ($data_cb) {
  64         $data_cb->($ua_resp->content, $resp);
  65     }
  66     else {
  67         $resp->{content} = $ua_resp->content;
  68     }
  69
  70     return $resp;
  71 }
  72
  73 1;