File Coverage

blib/lib/Future/HTTP/Tiny.pm
Criterion Covered Total %
statement 56 77 72.7
branch 4 6 66.6
condition 1 3 33.3
subroutine 10 13 76.9
pod 5 6 83.3
total 76 105 72.3


line stmt bran cond sub pod time code
1             package Future::HTTP::Tiny;
2 6     6   264179 use strict;
  6         16  
  6         258  
3 6     6   3954 use Future;
  6         102825  
  6         240  
4 6     6   3714 use HTTP::Tiny;
  6         294947  
  6         367  
5 6     6   5008 use Moo 2; # or Moo::Lax if you can't have Moo v2
  6         56511  
  6         42  
6 6     6   11658 use experimental 'signatures';
  6         5112  
  6         86  
7              
8             our $VERSION = '0.17';
9              
10             with 'Future::HTTP::Handler';
11              
12             has ua => (
13             is => 'lazy',
14             default => sub { HTTP::Tiny->new( %{ $_[0]->_ua_args } ) }
15             );
16              
17             has _ua_args => (
18             is => 'ro',
19             default => sub { +{} } ,
20             );
21              
22             =head1 NAME
23              
24             Future::HTTP::Tiny - synchronous HTTP client with a Future interface
25              
26             =head1 DESCRIPTION
27              
28             This is the default backend. It is chosen if no supported event loop could
29             be detected. It will execute the requests synchronously as they are
30             made in C<< ->http_request >> .
31              
32             =cut
33              
34             sub BUILDARGS {
35 1     1 0 1126107 my( $class, %options ) = @_;
36              
37 1 50       9 my @ua_args = keys %options ? (_ua_args => \%options) : ();
38             return +{
39             @ua_args
40 1         25 }
41             }
42              
43 1     1 1 16 sub is_async { !1 }
44              
45 6     6   11 sub _ae_from_http_tiny( $self, $result, $url ) {
  6         10  
  6         15  
  6         12  
  6         11  
46             # Convert the result back to a future
47 6         15 my( $body ) = delete $result->{content};
48 6         16 my( $headers ) = delete $result->{headers};
49 6         20 $headers->{Status} = delete $result->{status};
50 6         23 $headers->{Reason} = delete $result->{reason};
51 6   33     40 $headers->{URL} = delete $result->{url} || $url;
52              
53             # Only filled with HTTP::Tiny 0.058+!
54 6 100       58 if( $result->{redirects}) {
55 2         5 my $r = $headers;
56 2         5 for my $http_tiny_result ( reverse @{ $result->{redirects}}) {
  2         9  
57 3         15 $r->{Redirect} = [ $self->_ae_from_http_tiny( $http_tiny_result, $url ) ];
58 3         8 $r = $r->{Redirect}->[1]; # point to the new result headers
59             };
60             };
61              
62 6         19 return ($body, $headers)
63             };
64              
65 3     3   5 sub _request($self, $method, $url, %options) {
  3         9  
  3         16  
  3         5  
  3         6  
  3         4  
66              
67             # Munge the parameters for AnyEvent::HTTP to HTTP::Tiny
68 3         39 for my $rename (
69             ['body' => 'content'],
70             ['body_cb' => 'data_callback']
71             ) {
72 6         15 my( $from, $to ) = @$rename;
73 6 50       19 if( $options{ $from }) {
74 0         0 $options{ $to } = delete $options{ $from };
75             };
76             };
77              
78             # Execute the request (synchronously)
79 3         104 my $result = $self->ua->request(
80             $method => $url,
81             \%options
82             );
83              
84 3         70201 my $res = Future->new;
85 3         54 my( $body, $headers ) = $self->_ae_from_http_tiny( $result, $url );
86 3         31 $self->http_response_received( $res, $body, $headers );
87 3         1382 $res
88             }
89              
90 0     0 1 0 sub http_request($self,$method,$url,%options) {
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
91 0         0 $self->_request(
92             $method => $url,
93             %options
94             )
95             }
96              
97 3     3 1 5651 sub http_get($self,$url,%options) {
  3         9  
  3         11  
  3         7  
  3         32  
98 3         18 $self->_request(
99             'GET' => $url,
100             %options,
101             )
102             }
103              
104 0     0 1   sub http_head($self,$url,%options) {
  0            
  0            
  0            
  0            
105 0           $self->_request(
106             'HEAD' => $url,
107             %options
108             )
109             }
110              
111 0     0 1   sub http_post($self,$url,$body,%options) {
  0            
  0            
  0            
  0            
  0            
112 0           $self->_request(
113             'POST' => $url,
114             body => $body,
115             %options
116             )
117             }
118              
119             =head1 METHODS
120              
121             =head2 C<< Future::HTTP::Tiny->new() >>
122              
123             my $ua = Future::HTTP::Tiny->new();
124              
125             Creates a new instance of the HTTP client.
126              
127             =head2 C<< $ua->is_async() >>
128              
129             Returns false, because this backend is synchronous.
130              
131             =head2 C<< $ua->http_get($url, %options) >>
132              
133             $ua->http_get('http://example.com/',
134             headers => {
135             'Accept' => 'text/json',
136             },
137             )->then(sub {
138             my( $body, $headers ) = @_;
139             ...
140             });
141              
142             Retrieves the URL and returns the body and headers, like
143             the function in L.
144              
145             =head2 C<< $ua->http_head($url, %options) >>
146              
147             $ua->http_head('http://example.com/',
148             headers => {
149             'Accept' => 'text/json',
150             },
151             )->then(sub {
152             my( $body, $headers ) = @_;
153             ...
154             });
155              
156             Retrieves the header of the URL and returns the headers,
157             like the function in L.
158              
159             =head2 C<< $ua->http_post($url, $body, %options) >>
160              
161             $ua->http_post('http://example.com/api',
162             '{token:"my_json_token"}',
163             headers => {
164             'Accept' => 'text/json',
165             },
166             )->then(sub {
167             my( $body, $headers ) = @_;
168             ...
169             });
170              
171             Posts the content to the URL and returns the body and headers,
172             like the function in L.
173              
174             =head2 C<< $ua->http_request($method, $url, %options) >>
175              
176             $ua->http_request('PUT' => 'http://example.com/api',
177             headers => {
178             'Accept' => 'text/json',
179             },
180             body => '{token:"my_json_token"}',
181             )->then(sub {
182             my( $body, $headers ) = @_;
183             ...
184             });
185              
186             Posts the content to the URL and returns the body and headers,
187             like the function in L.
188              
189             =head1 COMPATIBILITY
190              
191             L is a good backend because it is distributed with many versions
192             of Perl. The drawback is that not all versions of L support all
193             features. The following features are unsupported on older versions of
194             L:
195              
196             =over 4
197              
198             =item C<< ->{URL} >>
199              
200             HTTP::Tiny versions before 0.018 didn't tell about 30x redirections.
201              
202             =item C<< ->{redirects} >>
203              
204             HTTP::Tiny versions before 0.058 didn't record the chain of redirects.
205              
206             =back
207              
208             =head1 SEE ALSO
209              
210             L
211              
212             L for the details of the API
213              
214             =head1 REPOSITORY
215              
216             The public repository of this module is
217             L.
218              
219             =head1 SUPPORT
220              
221             The public support forum of this module is
222             L.
223              
224             =head1 BUG TRACKER
225              
226             Please report bugs in this module via the RT CPAN bug queue at
227             L
228             or via mail to L.
229              
230             =head1 AUTHOR
231              
232             Max Maischein C
233              
234             =head1 COPYRIGHT (c)
235              
236             Copyright 2016-2024 by Max Maischein C.
237              
238             =head1 LICENSE
239              
240             This module is released under the same terms as Perl itself.
241              
242             =cut
243              
244             1;