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

   1 package HTTP::AnyUA::Backend::LWP::UserAgent;
   2 # ABSTRACT: A unified programming interface for LWP::UserAgent
   3
   4 =head1 DESCRIPTION
   5
   6 This module adds support for the HTTP client L<LWP::UserAgent> to be used with the unified
   7 programming interface provided by L<HTTP::AnyUA>.
   8
   9 =head1 SEE ALSO
  10
  11 =for :list
  12 * L<HTTP::AnyUA::Backend>
  13
  14 =cut
  15
  16 use warnings;
  17 use strict;
  18
  19 our $VERSION = '9999.999'; # VERSION
  20
  21 use parent 'HTTP::AnyUA::Backend';
  22
  23 use HTTP::AnyUA::Util;
  24
  25
  26 sub request {
  27     my $self = shift;
  28     my ($method, $url, $args) = @_;
  29
  30     my $r = HTTP::AnyUA::Util::native_to_http_request(@_);
  31
  32     my $ua_resp = $self->ua->request($r);
  33
  34     return $self->_munge_response($ua_resp, $args->{data_callback});
  35 }
  36
  37
  38 sub _munge_response {
  39     my $self    = shift;
  40     my $ua_resp = shift;
  41     my $data_cb = shift;
  42     my $recurse = shift;
  43
  44     my $resp = {
  45         success => !!$ua_resp->is_success,
  46         url     => $ua_resp->request->uri->as_string,
  47         status  => $ua_resp->code,
  48         reason  => $ua_resp->message,
  49         headers => HTTP::AnyUA::Util::http_headers_to_native($ua_resp->headers),
  50     };
  51
  52     $resp->{protocol} = $ua_resp->protocol if $ua_resp->protocol;
  53
  54     if (!$recurse) {
  55         for my $redirect ($ua_resp->redirects) {
  56             push @{$resp->{redirects} ||= []}, $self->_munge_response($redirect, undef, 1);
  57         }
  58     }
  59
  60     my $content_ref = $ua_resp->content_ref;
  61
  62     if (($resp->{headers}{'client-warning'} || '') eq 'Internal response') {
  63         HTTP::AnyUA::Util::internal_exception($$content_ref, $resp);
  64     }
  65     elsif ($data_cb) {
  66         $data_cb->($$content_ref, $resp);
  67     }
  68     else {
  69         $resp->{content} = $$content_ref;
  70     }
  71
  72     return $resp;
  73 }
  74
  75 1;