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
   5 use warnings;
   6 use strict;
   7
   8 our $VERSION = '0.900'; # VERSION
   9
  10 use parent 'HTTP::AnyUA::Backend';
  11
  12 use HTTP::AnyUA::Util;
  13
  14
  15 sub request {
  16     my $self = shift;
  17     my ($method, $url, $args) = @_;
  18
  19     my $r = HTTP::AnyUA::Util::native_to_http_request(@_);
  20
  21     my $ua_resp = $self->ua->request($r);
  22
  23     return $self->_munge_response($ua_resp, $args->{data_callback});
  24 }
  25
  26
  27 sub _munge_response {
  28     my $self    = shift;
  29     my $ua_resp = shift;
  30     my $data_cb = shift;
  31     my $recurse = shift;
  32
  33     my $resp = {
  34         success => !!$ua_resp->is_success,
  35         url     => $ua_resp->request->uri->as_string,
  36         status  => $ua_resp->code,
  37         reason  => $ua_resp->message,
  38         headers => HTTP::AnyUA::Util::http_headers_to_native($ua_resp->headers),
  39     };
  40
  41     $resp->{protocol} = $ua_resp->protocol if $ua_resp->protocol;
  42
  43     if (!$recurse) {
  44         for my $redirect ($ua_resp->redirects) {
  45             push @{$resp->{redirects} ||= []}, $self->_munge_response($redirect, undef, 1);
  46         }
  47     }
  48
  49     my $content_ref = $ua_resp->content_ref;
  50
  51     if (($resp->{headers}{'client-warning'} || '') eq 'Internal response') {
  52         HTTP::AnyUA::Util::internal_exception($$content_ref, $resp);
  53     }
  54     elsif ($data_cb) {
  55         $data_cb->($$content_ref, $resp);
  56     }
  57     else {
  58         $resp->{content} = $$content_ref;
  59     }
  60
  61     return $resp;
  62 }
  63
  64 1;
  65
  66 __END__
  67
  68 =pod
  69
  70 =encoding UTF-8
  71
  72 =head1 NAME
  73
  74 HTTP::AnyUA::Backend::LWP::UserAgent - A unified programming interface for LWP::UserAgent
  75
  76 =head1 VERSION
  77
  78 version 0.900
  79
  80 =head1 DESCRIPTION
  81
  82 This module adds support for the HTTP client L<LWP::UserAgent> to be used with the unified
  83 programming interface provided by L<HTTP::AnyUA>.
  84
  85 =head1 SEE ALSO
  86
  87 =over 4
  88
  89 =item *
  90
  91 L<HTTP::AnyUA::Backend>
  92
  93 =back
  94
  95 =head1 BUGS
  96
  97 Please report any bugs or feature requests on the bugtracker website
  98 L<https://github.com/chazmcgarvey/HTTP-AnyUA/issues>
  99
 100 When submitting a bug or request, please include a test-file or a
 101 patch to an existing test-file that illustrates the bug or desired
 102 feature.
 103
 104 =head1 AUTHOR
 105
 106 Charles McGarvey <chazmcgarvey@brokenzipper.com>
 107
 108 =head1 COPYRIGHT AND LICENSE
 109
 110 This software is copyright (c) 2017 by Charles McGarvey.
 111
 112 This is free software; you can redistribute it and/or modify it under
 113 the same terms as the Perl 5 programming language system itself.
 114
 115 =cut