]> Dogcows Code - chaz/p5-HTTP-AnyUA/blob - lib/HTTP/AnyUA.pm
7b2996d83632da82c62d3762c52ac8d22426b79a
[chaz/p5-HTTP-AnyUA] / lib / HTTP / AnyUA.pm
1 package HTTP::AnyUA;
2 # ABSTRACT: An HTTP user agent programming interface unification layer
3
4 =head1 SYNOPSIS
5
6 my $any_ua = HTTP::AnyUA->new(ua => LWP::UserAgent->new);
7 # OR: my $any_ua = HTTP::AnyUA->new(ua => Furl->new);
8 # OR: my $any_ua = HTTP::AnyUA->new(ua => HTTP::Tiny->new);
9 # etc...
10
11 my $response = $any_ua->get('http://www.example.com/');
12
13 print "$response->{status} $response->{reason}\n";
14
15 while (my ($k, $v) = each %{$response->{headers}}) {
16 for (ref $v eq 'ARRAY' ? @$v : $v) {
17 print "$k: $_\n";
18 }
19 }
20
21 print $response->{content} if length $response->{content};
22
23 ### Non-blocking user agents cause Future objects to be returned:
24
25 my $any_ua = HTTP::AnyUA->new(ua => HTTP::Tiny->new, response_is_future => 1);
26 # OR: my $any_ua = HTTP::AnyUA->new(ua => 'AnyEvent::HTTP');
27 # OR: my $any_ua = HTTP::AnyUA->new(ua => Mojo::UserAgent->new);
28 # etc...
29
30 my $future = $any_ua->get('http://www.example.com/');
31
32 $future->on_done(sub {
33 my $response = shift;
34
35 print "$response->{status} $response->{reason}\n";
36
37 while (my ($k, $v) = each %{$response->{headers}}) {
38 for (ref $v eq 'ARRAY' ? @$v : $v) {
39 print "$k: $_\n";
40 }
41 }
42
43 print $response->{content} if length $response->{content};
44 });
45
46 $future->on_fail(sub { print STDERR "Oh no!!\n" });
47
48 =head1 DESCRIPTION
49
50 This module provides a small wrapper for unifying the programming interfaces of several different
51 actual user agents (HTTP clients) under one B<familiar> interface.
52
53 Rather than providing yet another programming interface for you to learn, HTTP::AnyUA follows the
54 L<HTTP::Tiny> interface. This also means that you can plug in any supported HTTP client
55 (L<LWP::UserAgent>, L<Furl>, etc.) and use it as if it were L<HTTP::Tiny>.
56
57 There are a lot of great HTTP clients available for Perl, each with different goals, different
58 feature sets, and of course different programming interfaces! If you're an end user, you can just
59 pick one of these clients according to the needs of your project (or personal preference). But if
60 you're writing a module that needs to interface with a web server (like perhaps a RESTful API
61 wrapper) and you want your users to be able to use whatever HTTP client they want, HTTP::AnyUA can
62 help you support that!
63
64 It's a good idea to let the end user pick whatever HTTP client they want to use, because they're the
65 one who knows the requirements of their application or script. If you're writing an event-driven
66 application, you'll need to use a non-blocking user agent like L<Mojo::UserAgent>. If you're writing
67 a simple command-line script, you may decide that your priority is to minimize dependencies and so
68 may want to go with L<HTTP::Tiny>.
69
70 Unfortunately, many modules on CPAN are hardcoded to work with specific HTTP clients, leaving the
71 end user unable to use the HTTP client that would be best for them. Although the end user won't --
72 or at least doesn't need to -- use HTTP::AnyUA directly, they will benefit from client choice if
73 their third-party modules use HTTP::AnyUA or something like it.
74
75 The primary goal of HTTP::AnyUA is to make it easy for module developers to write HTTP code once
76 that can work with any HTTP client the end user may decide to plug in. A secondary goal is to make
77 it easy for anyone to add support for new or yet-unsupported user agents.
78
79 =head1 SUPPORTED USER AGENTS
80
81 =for :list
82 * L<AnyEvent::HTTP>
83 * L<Furl>
84 * L<HTTP::AnyUA> - a little bit meta, but why not?
85 * L<HTTP::Tiny>
86 * L<LWP::UserAgent>
87 * L<Mojo::UserAgent>
88 * L<Net::Curl::Easy>
89
90 Any HTTP client that inherits from one of these in a well-behaved manner should also be supported.
91
92 Of course, there are many other HTTP clients on CPAN that HTTP::AnyUA doesn't yet support. I'm more
93 than happy to help add support for others, so send me a message if you know of an HTTP client that
94 needs support. See L<HTTP::AnyUA::Backend> for how to write support for a new HTTP client.
95
96 =head1 NON-BLOCKING USER AGENTS
97
98 HTTP::AnyUA tries to target the L<HTTP::Tiny> interface, which is a blocking interface. This means
99 that when you call L</request>, it is supposed to not return until either the response is received
100 or an error occurs. This doesn't jive well with non-blocking HTTP clients which expect the flow to
101 reenter an event loop so that the request can complete concurrently.
102
103 In order to reconcile this, a L<Future> will be returned instead of the normal hashref response if
104 the wrapped HTTP client is non-blocking (such as L<Mojo::UserAgent> or L<AnyEvent::HTTP>). This
105 L<Future> object may be used to set up callbacks that will be called when the request is completed.
106 You can call L</response_is_future> to know if the response is or will be a L<Future>.
107
108 This is typically okay for the end user; since they're the one who chose which HTTP client to use in
109 the first place, they should know whether they should expect a L<Future> or a direct response when
110 they make an HTTP request, but it does add some burden on you as a module writer because if you ever
111 need to examine the response, you may need to write code like this:
112
113 my $resp = $any_ua->get('http://www.perl.org/');
114
115 if ($any_ua->response_is_future) {
116 $resp->on_done(sub {
117 my $real_resp = shift;
118 handle_response($real_resp);
119 });
120 }
121 else {
122 handle_response($resp); # response is the real response already
123 }
124
125 This actually isn't too annoying to deal with in practice, but you can avoid it if you like by
126 forcing the response to always be a L<Future>. Just set the L</response_is_future> attribute. Then
127 you don't need to do an if-else because the response will always be the same type:
128
129 $any_ua->response_is_future(1);
130
131 my $resp = $any_ua->get('http://www.perl.org/');
132
133 $resp->on_done(sub { # response is always a Future
134 my $real_resp = shift;
135 handle_response($real_resp);
136 });
137
138 Note that this doesn't make a blocking HTTP client magically non-blocking. The call to L</request>
139 will still block if the client is blocking, and your "done" callback will simply be fired
140 immediately. But this does let you write the same code in your module and have it work regardless of
141 whether the underlying HTTP client is blocking or non-blocking.
142
143 The default behavior is to return a direct hashref response if the HTTP client is blocking and
144 a L<Future> if the client is non-blocking. It's up to you to decide whether or not to set
145 C<response_is_future>, and you should also consider whether you want to expose the possibility of
146 either type of response or always returning L<Future> objects to the end user of your module. It
147 doesn't matter for users who choose non-blocking HTTP clients because they will be using L<Future>
148 objects either way, but users who know they are using a blocking HTTP client may appreciate not
149 having to deal with L<Future> objects at all.
150
151 =head1 FREQUENTLY ASKED QUESTIONS
152
153 =head2 How do I set up proxying, SSL, cookies, timeout, etc.?
154
155 HTTP::AnyUA provides a common interface for I<using> HTTP clients, not for instantiating or
156 configuring them. Proxying, SSL, and other custom settings can be configured directly through the
157 underlying HTTP client; see the documentation for your particular user agent to learn how to
158 configure these things.
159
160 L<AnyEvent::HTTP> is a bit of a special case because there is no instantiated object representing
161 the client. For this particular user agent, you can configure the backend to pass a default set of
162 options whenever it calls C<http_request>. See L<HTTP::AnyUA::Backend::AnyEvent::HTTP/options>:
163
164 $any_ua->backend->options({recurse => 5, timeout => 15});
165
166 If you are a module writer, you should probably receive a user agent from your end user and leave
167 this type of configuration up to them.
168
169 =head2 Why use HTTP::AnyUA instead of some other HTTP client?
170
171 Maybe you shouldn't. If you're an end user writing a script or application, you can just pick the
172 HTTP client that suits you best and use it. For example, if you're writing a L<Mojolicious> app,
173 you're not going wrong by using L<Mojo::UserAgent>; it's loaded with features and is well-integrated
174 with that particular environment.
175
176 As an end user, you I<could> wrap the HTTP client you pick in an HTTP::AnyUA object, but the only
177 reason to do this is if you prefer using the L<HTTP::Tiny> interface.
178
179 The real benefit of HTTP::AnyUA (or something like it) is if module writers use it to allow end
180 users of their modules to be able to plug in whatever HTTP client they want. For example, a module
181 that implements an API wrapper that has a hard dependency on L<LWP::UserAgent> or even L<HTTP::Tiny>
182 is essentially useless for non-blocking applications. If the same hypothetical module had been
183 written using HTTP::AnyUA then it would be useful in any scenario.
184
185 =head2 Why use the HTTP::Tiny interface?
186
187 The L<HTTP::Tiny> interface is simple but provides all the essential functionality needed for
188 a capable HTTP client and little more. That makes it easy to provide an implementation for, and it
189 also makes it straightforward for module authors to use.
190
191 Marrying the L<HTTP::Tiny> interface with L<Future> gives us these benefits for both blocking and
192 non-blocking modules and applications.
193
194 =head1 SPECIFICATION
195
196 This section specifies a standard set of data structures that can be used to make a request and get
197 a response from a user agent. This is the specification HTTP::AnyUA uses for its programming
198 interface. It is heavily based on L<HTTP::Tiny>'s interface, and parts of this specification were
199 adapted or copied verbatim from that module's documentation. The intent is for this specification to
200 be written such that L<HTTP::Tiny> is already a compliant implementor of the specification (at least
201 as of the specification's publication date).
202
203 =head2 The Request
204
205 A request is a tuple of the form C<(Method, URL)> or C<(Method, URL, Options)>.
206
207 =head3 Method
208
209 Method B<MUST> be a string representing the HTTP verb. This is commonly C<"GET">, C<"POST">,
210 C<"HEAD">, C<"DELETE">, etc.
211
212 =head3 URL
213
214 URL B<MUST> be a string representing the remote resource to be acted upon. The URL B<MUST> have
215 unsafe characters escaped and international domain names encoded before being passed to the user
216 agent. A user agent B<MUST> generate a C<"Host"> header based on the URL in accordance with RFC
217 2616; a user agent B<MAY> throw an error if a C<"Host"> header is given with the L</headers>.
218
219 =head3 Options
220
221 Options, if present, B<MUST> be a hash reference containing zero or more of the following keys with
222 appropriate values. A user agent B<MAY> support more options than are specified here.
223
224 =head4 headers
225
226 The value for the C<headers> key B<MUST> be a hash reference containing zero or more HTTP header
227 names (as keys) and header values. The value for a header B<MUST> be either a string containing the
228 header value OR an array reference where each item is a string. If the value for a header is an
229 array reference, the user agent B<MUST> output the header multiple times with each value in the
230 array.
231
232 User agents B<MAY> may add headers, but B<SHOULD NOT> replace user-specified headers unless
233 otherwise documented.
234
235 =head4 content
236
237 The value for the C<content> key B<MUST> be a string OR a code reference. If the value is a string,
238 its contents will be included with the request as the body. If the value is a code reference, the
239 referenced code will be called iteratively to produce the body of the request, and the code B<MUST>
240 return an empty string or undef value to indicate the end of the request body. If the value is
241 a code reference, a user agent B<SHOULD> use chunked transfer encoding if it supports it, otherwise
242 a user agent B<MAY> completely drain the code of content before sending the request.
243
244 =head4 data_callback
245
246 The value for the C<data_callback> key B<MUST> be a code reference that will be called zero or more
247 times, once for each "chunk" of response body received. A user agent B<MAY> send the entire response
248 body in one call. The referenced code B<MUST> be given two arguments; the first is a string
249 containing a chunk of the response body, the second is an in-progress L<response|/The Response>.
250
251 =head2 The Response
252
253 A response B<MUST> be a hash reference containg some required keys and values. A response B<MAY>
254 contain some optional keys and values.
255
256 =head3 success
257
258 A response B<MUST> include a C<success> key, the value of which is a boolean indicating whether or
259 not the request is to be considered a success (true is a success). Unless otherwise documented,
260 a successful result means that the operation returned a 2XX status code.
261
262 =head3 url
263
264 A response B<MUST> include a C<url> key, the value of which is the URL that provided the response.
265 This is the URL used in the request unless there were redirections, in which case it is the last URL
266 queried in a redirection chain.
267
268 =head3 status
269
270 A response B<MUST> include a C<status> key, the value of which is the HTTP status code of the
271 response. If an internal exception occurs (e.g. connection error), then the status code B<MUST> be
272 C<599>.
273
274 =head3 reason
275
276 A response B<MUST> include a C<reason> key, the value of which is the response phrase returned by
277 the server OR "Internal Exception" if an internal exception occurred.
278
279 =head3 content
280
281 A response B<MAY> include a C<content> key, the value of which is the response body returned by the
282 server OR the text of the exception if an internal exception occurred. This field B<MUST> be missing
283 or empty if the server provided no response OR if the body was already provided via
284 L</data_callback>.
285
286 =head3 headers
287
288 A response B<SHOULD> include a C<headers> key, the value of which is a hash reference containing
289 zero or more HTTP header names (as keys) and header values. Keys B<MUST> be lowercased. The value
290 for a header B<MUST> be either a string containing the header value OR an array reference where each
291 item is the value of one of the repeated headers.
292
293 =head3 redirects
294
295 A response B<MAY> include a C<redirects> key, the value of which is an array reference of one or
296 more responses from redirections that occurred to fulfill the current request, in chronological
297 order.
298
299 =head1 ENVIRONMENT
300
301 =for :list
302 * C<PERL_HTTP_ANYUA_DEBUG> - If 1, print some info useful for debugging to C<STDERR>.
303
304 =head1 CAVEATS
305
306 Not all HTTP clients implement the same features or in the same ways. While the point of HTTP::AnyUA
307 is to hide those differences, you may notice some (hopefully) I<insignificant> differences when
308 plugging in different clients. For example, L<LWP::UserAgent> sets some headers on the response such
309 as C<client-date> and C<client-peer> that won't appear when using other clients. Little differences
310 like these probably aren't a big deal. Other differences may be a bigger deal, depending on what's
311 important to you. For example, some clients (like L<HTTP::Tiny>) may do chunked transfer encoding in
312 situations where other clients won't (probably because they don't support it). It's not a goal of
313 this project to eliminate I<all> of the differences, but if you come across a difference that is
314 significant enough that you think you need to detect the user agent and write special logic, I would
315 like to learn about your use case.
316
317 =head1 SEE ALSO
318
319 These modules share similar goals or provide overlapping functionality:
320
321 =for :list
322 * L<Future::HTTP>
323 * L<HTTP::Any>
324 * L<HTTP::Tinyish>
325 * L<Plient>
326
327 =cut
328
329 use 5.010;
330 use warnings;
331 use strict;
332
333 our $VERSION = '9999.999'; # VERSION
334
335 use HTTP::AnyUA::Util;
336 use Module::Loader;
337 use Scalar::Util;
338
339
340 our $BACKEND_NAMESPACE;
341 our @BACKENDS;
342 our %REGISTERED_BACKENDS;
343
344 BEGIN {
345 $BACKEND_NAMESPACE = __PACKAGE__ . '::Backend';
346 }
347
348
349 sub _debug_log { print STDERR join(' ', @_), "\n" if $ENV{PERL_HTTP_ANYUA_DEBUG} }
350
351 sub _croak { require Carp; Carp::croak(@_) }
352 sub _usage { _croak("Usage: @_\n") }
353
354
355 =method new
356
357 $any_ua = HTTP::AnyUA->new(ua => $user_agent, %attr);
358 $any_ua = HTTP::AnyUA->new($user_agent, %attr);
359
360 Construct a new HTTP::AnyUA.
361
362 =cut
363
364 sub new {
365 my $class = shift;
366 unshift @_, 'ua' if @_ % 2;
367 my %args = @_;
368 $args{ua} or _usage(q{HTTP::AnyUA->new(ua => $user_agent, %attr)});
369
370 my $self;
371 my @attr = qw(ua backend response_is_future);
372
373 for my $attr (@attr) {
374 $self->{$attr} = $args{$attr} if defined $args{$attr};
375 }
376
377 bless $self, $class;
378
379 $self->_debug_log('Created with user agent', $self->ua);
380
381 # call accessors to get the checks to run
382 $self->ua;
383 $self->response_is_future($args{response_is_future}) if defined $args{response_is_future};
384
385 return $self;
386 }
387
388 =attr ua
389
390 Get the user agent that was passed to L</new>.
391
392 =cut
393
394 sub ua { shift->{ua} or _croak 'User agent is required' }
395
396 =attr response_is_future
397
398 Get and set whether or not responses are L<Future> objects.
399
400 =cut
401
402 sub response_is_future {
403 my $self = shift;
404 my $val = shift;
405
406 if (defined $val) {
407 $self->_debug_log('Set response_is_future to', $val ? 'ON' : 'OFF');
408
409 $self->_check_response_is_future($val);
410 $self->{response_is_future} = $val;
411
412 $self->_module_loader->load('Future') if $self->{response_is_future};
413 }
414 elsif (!defined $self->{response_is_future} && $self->{backend}) {
415 $self->{response_is_future} = $self->backend->response_is_future;
416
417 $self->_module_loader->load('Future') if $self->{response_is_future};
418 }
419
420 return $self->{response_is_future} || '';
421 }
422
423 =attr backend
424
425 Get the backend instance. You normally shouldn't need this.
426
427 =cut
428
429 sub backend {
430 my $self = shift;
431
432 return $self->{backend} if defined $self->{backend};
433
434 $self->{backend} = $self->_build_backend;
435 $self->_check_response_is_future($self->response_is_future);
436
437 return $self->{backend};
438 }
439
440 =method request
441
442 $response = $any_ua->request($method, $url);
443 $response = $any_ua->request($method, $url, \%options);
444
445 Make a L<request|/"The Request">, get a L<response|/"The Response">.
446
447 Compare to L<HTTP::Tiny/request>.
448
449 =cut
450
451 sub request {
452 my ($self, $method, $url, $args) = @_;
453 $args ||= {};
454 @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
455 or _usage(q{$any_ua->request($method, $url, \%options)});
456
457 my $resp = eval { $self->backend->request(uc($method) => $url, $args) };
458 if (my $err = $@) {
459 return $self->_wrap_internal_exception($err);
460 }
461
462 return $self->_wrap_response($resp);
463 }
464
465 =method get, head, put, post, delete
466
467 $response = $any_ua->get($url);
468 $response = $any_ua->get($url, \%options);
469 $response = $any_ua->head($url);
470 $response = $any_ua->head($url, \%options);
471 # etc.
472
473 Shortcuts for L</request> where the method is the method name rather than the first argument.
474
475 Compare to L<HTTP::Tiny/getE<verbar>headE<verbar>putE<verbar>postE<verbar>delete>.
476
477 =cut
478
479 # adapted from HTTP/Tiny.pm
480 for my $sub_name (qw{get head put post delete}) {
481 my %swap = (SUBNAME => $sub_name, METHOD => uc($sub_name));
482 my $code = q[
483 sub {{SUBNAME}} {
484 my ($self, $url, $args) = @_;
485 @_ == 2 || (@_ == 3 && ref $args eq 'HASH')
486 or _usage(q{$any_ua->{{SUBNAME}}($url, \%options)});
487 return $self->request('{{METHOD}}', $url, $args);
488 }
489 ];
490 $code =~ s/\{\{([A-Z_]+)\}\}/$swap{$1}/ge;
491 eval $code; ## no critic
492 }
493
494 =method post_form
495
496 $response = $any_ua->post_form($url, $formdata);
497 $response = $any_ua->post_form($url, $formdata, \%options);
498
499 Does a C<POST> request with the form data encoded and sets the C<Content-Type> header to
500 C<application/x-www-form-urlencoded>.
501
502 Compare to L<HTTP::Tiny/post_form>.
503
504 =cut
505
506 # adapted from HTTP/Tiny.pm
507 sub post_form {
508 my ($self, $url, $data, $args) = @_;
509 (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
510 or _usage(q{$any_ua->post_form($url, $formdata, \%options)});
511
512 my $headers = {};
513 while (my ($key, $value) = each %{$args->{headers} || {}}) {
514 $headers->{lc $key} = $value;
515 }
516 delete $args->{headers};
517
518 return $self->request(POST => $url, {
519 %$args,
520 content => HTTP::AnyUA::Util::www_form_urlencode($data),
521 headers => {
522 %$headers,
523 'content-type' => 'application/x-www-form-urlencoded',
524 },
525 });
526 }
527
528 =method mirror
529
530 $response = $http->mirror($url, $filepath, \%options);
531 if ($response->{success}) {
532 print "$filepath is up to date\n";
533 }
534
535 Does a C<GET> request and saves the downloaded document to a file. If the file already exists, its
536 timestamp will be sent using the C<If-Modified-Since> request header (which you can override). If
537 the server responds with a C<304> (Not Modified) status, the C<success> field will be true; this is
538 usually only the case for C<2XX> statuses. If the server responds with a C<Last-Modified> header,
539 the file will be updated to have the same modification timestamp.
540
541 Compare to L<HTTP::Tiny/mirror>. This version differs slightly in that this returns internal
542 exception responses (for cases like being unable to write the file locally, etc.) rather than
543 actually throwing the exceptions. The reason for this is that exceptions as responses are easier to
544 deal with for non-blocking HTTP clients, and the fact that this method throws exceptions in
545 L<HTTP::Tiny> seems like an inconsistency in its interface.
546
547 =cut
548
549 # adapted from HTTP/Tiny.pm
550 sub mirror {
551 my ($self, $url, $file, $args) = @_;
552 @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
553 or _usage(q{$any_ua->mirror($url, $filepath, \%options)});
554
555 if (exists $args->{headers}) {
556 my $headers = {};
557 while (my ($key, $value) = each %{$args->{headers} || {}}) {
558 $headers->{lc($key)} = $value;
559 }
560 $args->{headers} = $headers;
561 }
562
563 if (-e $file and my $mtime = (stat($file))[9]) {
564 $args->{headers}{'if-modified-since'} ||= HTTP::AnyUA::Util::http_date($mtime);
565 }
566 my $tempfile = $file . int(rand(2**31));
567
568 # set up the response body to be written to the file
569 require Fcntl;
570 sysopen(my $fh, $tempfile, Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY())
571 or return $self->_wrap_internal_exception(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/);
572 binmode $fh;
573 $args->{data_callback} = sub { print $fh $_[0] };
574
575 my $resp = $self->request(GET => $url, $args);
576
577 my $finish = sub {
578 my $resp = shift;
579
580 close $fh
581 or return HTTP::AnyUA::Util::internal_exception(qq/Error: Caught error closing temporary file $tempfile: $!\n/);
582
583 if ($resp->{success}) {
584 rename($tempfile, $file)
585 or return HTTP::AnyUA::Util::internal_exception(qq/Error replacing $file with $tempfile: $!\n/);
586 my $lm = $resp->{headers}{'last-modified'};
587 if ($lm and my $mtime = HTTP::AnyUA::Util::parse_http_date($lm)) {
588 utime($mtime, $mtime, $file);
589 }
590 }
591 unlink($tempfile);
592
593 $resp->{success} ||= $resp->{status} eq '304';
594
595 return $resp;
596 };
597
598 if ($self->response_is_future) {
599 return $resp->followed_by(sub {
600 my $future = shift;
601 my @resp = $future->is_done ? $future->get : $future->failure;
602 my $resp = $finish->(@resp);
603 if ($resp->{success}) {
604 return Future->done(@resp);
605 }
606 else {
607 return Future->fail(@resp);
608 }
609 });
610 }
611 else {
612 return $finish->($resp);
613 }
614 }
615
616 =method register_backend
617
618 HTTP::AnyUA->register_backend($user_agent_package => $backend_package);
619 HTTP::AnyUA->register_backend('MyAgent' => 'MyBackend'); # HTTP::AnyUA::Backend::MyBackend
620 HTTP::AnyUA->register_backend('LWP::UserAgent' => '+SpecialBackend'); # SpecialBackend
621
622 Register a backend for a new user agent type or override a default backend. Backend packages are
623 relative to the C<HTTP::AnyUA::Backend::> namespace unless prefixed with a C<+>.
624
625 If you only need to set a backend as a one-off thing, you could also pass an instantiated backend to
626 L</new>.
627
628 =cut
629
630 sub register_backend {
631 my ($class, $ua_type, $backend_class) = @_;
632 @_ == 3 or _usage(q{HTTP::AnyUA->register_backend($ua_type, $backend_package)});
633
634 if ($backend_class) {
635 $backend_class = "${BACKEND_NAMESPACE}::${backend_class}" unless $backend_class =~ s/^\+//;
636 $REGISTERED_BACKENDS{$ua_type} = $backend_class;
637 }
638 else {
639 delete $REGISTERED_BACKENDS{$ua_type};
640 }
641 }
642
643
644 # turn a response into a Future if it needs to be
645 sub _wrap_response {
646 my $self = shift;
647 my $resp = shift;
648
649 if ($self->response_is_future && !$self->backend->response_is_future) {
650 # wrap the response in a Future
651 if ($resp->{success}) {
652 $self->_debug_log('Wrapped successful response in a Future');
653 $resp = Future->done($resp);
654 }
655 else {
656 $self->_debug_log('Wrapped failed response in a Future');
657 $resp = Future->fail($resp);
658 }
659 }
660
661 return $resp;
662 }
663
664 sub _wrap_internal_exception { shift->_wrap_response(HTTP::AnyUA::Util::internal_exception(@_)) }
665
666 # get a module loader object
667 sub _module_loader { shift->{_module_loader} ||= Module::Loader->new }
668
669 # get a list of potential backends that may be able to handle the user agent
670 sub _build_backend {
671 my $self = shift;
672 my $ua = shift || $self->ua or _croak 'User agent is required';
673
674 my $ua_type = Scalar::Util::blessed($ua);
675
676 my @classes;
677
678 if ($ua_type) {
679 push @classes, $REGISTERED_BACKENDS{$ua_type} if $REGISTERED_BACKENDS{$ua_type};
680
681 push @classes, "${BACKEND_NAMESPACE}::${ua_type}";
682
683 if (!@BACKENDS) {
684 # search for some backends to try
685 @BACKENDS = sort $self->_module_loader->find_modules($BACKEND_NAMESPACE);
686 $self->_debug_log('Found backends to try (' . join(', ', @BACKENDS) . ')');
687 }
688
689 for my $backend_type (@BACKENDS) {
690 my $plugin = $backend_type;
691 $plugin =~ s/^\Q${BACKEND_NAMESPACE}\E:://;
692 push @classes, $backend_type if $ua->isa($plugin);
693 }
694 }
695 else {
696 push @classes, $REGISTERED_BACKENDS{$ua} if $REGISTERED_BACKENDS{$ua};
697 push @classes, "${BACKEND_NAMESPACE}::${ua}";
698 }
699
700 for my $class (@classes) {
701 if (eval { $self->_module_loader->load($class); 1 }) {
702 $self->_debug_log("Found usable backend (${class})");
703 return $class->new($self->ua);
704 }
705 else {
706 $self->_debug_log($@);
707 }
708 }
709
710 _croak 'Cannot find a usable backend that supports the given user agent';
711 }
712
713 # make sure the response_is_future setting is compatible with the backend
714 sub _check_response_is_future {
715 my $self = shift;
716 my $val = shift;
717
718 # make sure the user agent is not non-blocking
719 if (!$val && $self->{backend} && $self->backend->response_is_future) {
720 _croak 'Cannot disable response_is_future with a non-blocking user agent';
721 }
722 }
723
724 1;
This page took 0.081915 seconds and 3 git commands to generate.