File Coverage

blib/lib/LWP/UserAgent/Paranoid/Test.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1 2     2   31098 use strict;
  2         2  
  2         70  
2 2     2   7 use warnings;
  2         2  
  2         54  
3 2     2   6 no warnings "void";
  2         7  
  2         71  
4              
5             package LWP::UserAgent::Paranoid::Test;
6              
7 2     2   8 use Test::More;
  2         1  
  2         8  
8 2         8 use Test::Requires qw(
9             Test::TCP
10             HTTP::Server::PSGI
11 2     2   1266 );
  2         1278  
12 2     2   178620 use LWP::UserAgent::Paranoid;
  0            
  0            
13              
14             use base 'Exporter';
15             our @EXPORT = qw/ server create_ua_ok get_status_is /;
16              
17             sub server {
18             my $app = shift;
19             my $host = "127.0.0.1";
20             my $tcp = Test::TCP->new(
21             code => sub {
22             my $port = shift;
23             my $server = HTTP::Server::PSGI->new(
24             host => $host,
25             port => $port,
26             timeout => 20,
27             );
28             $server->run($app);
29             }
30             );
31             return ("http://$host:" . $tcp->port, $tcp);
32             }
33              
34             sub create_ua_ok {
35             my $ua = LWP::UserAgent::Paranoid->new;
36             ok $ua, "Created agent object";
37             isa_ok $ua, "LWP::UserAgent::Paranoid";
38             return $ua;
39             }
40              
41             sub get_status_is {
42             my ($ua, $url, $status, $desc) = @_;
43             $desc ||= "GET $url";
44              
45             subtest $desc => sub {
46             my $r = $ua->get($url);
47             ok $r, "Received a response";
48             isa_ok $r, "HTTP::Response";
49             is $r->code, $status, "Status is $status"
50             or diag $r->status_line;
51             };
52             }
53              
54             "I want to believe.";