File Coverage

blib/lib/Test2/Tools/HTTP/UA/LWP.pm
Criterion Covered Total %
statement 27 28 96.4
branch 7 8 87.5
condition 5 9 55.5
subroutine 8 8 100.0
pod 0 2 0.0
total 47 55 85.4


line stmt bran cond sub pod time code
1             package Test2::Tools::HTTP::UA::LWP;
2              
3 7     7   198091 use strict;
  7         38  
  7         301  
4 7     7   39 use warnings;
  7         16  
  7         558  
5 7     7   154 use 5.014;
  7         25  
6 7     7   523 use URI;
  7         5105  
  7         264  
7 7     7   548 use parent 'Test2::Tools::HTTP::UA';
  7         267  
  7         83  
8              
9             # ABSTRACT: LWP user agent wrapper for Test2::Tools::HTTP
10             our $VERSION = '0.12'; # VERSION
11              
12              
13             sub instrument
14             {
15 5     5 0 21 my($self) = @_;
16              
17             my $cb = $self->{request_send_cb} ||= sub {
18 37     37   51776 my($req, $ua, $h) = @_;
19              
20 37 50       175 if(my $tester = $self->apps->uri_to_tester($req->uri))
21             {
22 37         14018 return $tester->request($req);
23             }
24             else
25             {
26 0         0 return;
27             }
28 5   33     88 };
29              
30 5         40 $self->ua->set_my_handler( 'request_send' => $cb );
31             }
32              
33             sub request
34             {
35 38     38 0 4489 my($self, $req, %options) = @_;
36              
37 38 100 100     167 if($self->apps->uri_to_app($req->uri) && $req->uri =~ /^\//)
38             {
39 5         91 $req->uri(
40             URI->new_abs($req->uri, $self->apps->base_url),
41             );
42             }
43              
44             my $res = $options{follow_redirects}
45 38 100       2278 ? $self->ua->request($req)
46             : $self->ua->simple_request($req);
47              
48 38 100       57569 if(my $warning = $res->header('Client-Warning'))
49             {
50 1   33     74 $self->error(
51             "connection error: " . ($res->decoded_content || $warning),
52             $res,
53             );
54             }
55              
56 37         2345 $res;
57             }
58              
59             __PACKAGE__->register('LWP::UserAgent', 'instance');
60              
61             1;
62              
63             __END__