File Coverage

blib/lib/Test2/Tools/HTTP/UA/LWP.pm
Criterion Covered Total %
statement 25 26 96.1
branch 7 8 87.5
condition 5 8 62.5
subroutine 7 7 100.0
pod 0 2 0.0
total 44 51 86.2


line stmt bran cond sub pod time code
1             package Test2::Tools::HTTP::UA::LWP;
2              
3 7     7   193992 use strict;
  7         20  
  7         185  
4 7     7   32 use warnings;
  7         13  
  7         158  
5 7     7   483 use URI;
  7         4028  
  7         144  
6 7     7   31 use parent 'Test2::Tools::HTTP::UA';
  7         13  
  7         40  
7              
8             # ABSTRACT: LWP user agent wrapper for Test2::Tools::HTTP
9             our $VERSION = '0.11'; # VERSION
10              
11              
12             sub instrument
13             {
14 5     5 0 14 my($self) = @_;
15              
16             my $cb = $self->{request_send_cb} ||= sub {
17 37     37   30237 my($req, $ua, $h) = @_;
18              
19 37 50       103 if(my $tester = $self->apps->uri_to_tester($req->uri))
20             {
21 37         10672 return $tester->request($req);
22             }
23             else
24             {
25 0         0 return;
26             }
27 5   50     60 };
28              
29 5         28 $self->ua->set_my_handler( 'request_send' => $cb );
30             }
31              
32             sub request
33             {
34 38     38 0 3524 my($self, $req, %options) = @_;
35              
36 38 100 100     101 if($self->apps->uri_to_app($req->uri) && $req->uri =~ /^\//)
37             {
38 5         71 $req->uri(
39             URI->new_abs($req->uri, $self->apps->base_url),
40             );
41             }
42              
43             my $res = $options{follow_redirects}
44 38 100       1399 ? $self->ua->request($req)
45             : $self->ua->simple_request($req);
46              
47 38 100       41359 if(my $warning = $res->header('Client-Warning'))
48             {
49 1   33     46 $self->error(
50             "connection error: " . ($res->decoded_content || $warning),
51             $res,
52             );
53             }
54              
55 37         1662 $res;
56             }
57              
58             __PACKAGE__->register('LWP::UserAgent', 'instance');
59              
60             1;
61              
62             __END__