File Coverage

inc/Mock/HTTP/Tiny.pm
Criterion Covered Total %
statement 55 58 94.8
branch 14 24 58.3
condition 8 16 50.0
subroutine 15 15 100.0
pod 5 5 100.0
total 97 118 82.2


line stmt bran cond sub pod time code
1             package HTTP::Tiny;
2              
3 1     1   17 use 5.008;
  1         3  
4              
5 1     1   5 use strict;
  1         4  
  1         18  
6 1     1   4 use warnings;
  1         2  
  1         21  
7              
8 1     1   4 use Carp;
  1         1  
  1         160  
9 1     1   780 use Storable ();
  1         3531  
  1         52  
10              
11             our $VERSION = '0.011';
12              
13 1     1   7 use constant HASH_REF => ref {};
  1         2  
  1         129  
14              
15             BEGIN {
16 1     1   4 local $@ = undef;
17              
18             eval {
19 1         855 require HTTP::Status;
20 0         0 *_status_message = \&HTTP::Status::status_message;
21 0         0 1;
22             } or *_status_message = sub {
23 15     15   28 my ( $status ) = @_;
24 15 100       23 return _is_success( $status ) ? 'OK' : 'Failed';
25 1 50       2 };
26             }
27              
28             sub new {
29 13     13 1 28 my ( $class, %arg ) = @_;
30             defined $arg{fn}
31 13 50       48 or $arg{fn} = 't/data/_http/status';
32 13 50       29 if ( defined $arg{agent} ) {
33             $arg{agent} =~ m/ \s \z /smx
34 0 0       0 and $arg{agent} .= $class->_default_agent();
35             } else {
36 13         30 $arg{agent} = $class->_default_agent();
37             }
38 13   33     98 return bless \%arg, ref $class || $class;
39             }
40              
41             sub agent {
42 1     1 1 2 my ( $invocant ) = @_;
43 1 50       4 ref $invocant
44             or return $invocant->_default_agent();
45 1         3 return $invocant->{agent};
46             }
47              
48             sub _default_agent {
49 13     13   23 my ( $self ) = @_;
50 13   33     87 ( my $agent = ref $self || $self ) =~ s/ :: /-/smxg;
51 13         159 return join '/', "Mock $agent", $self->VERSION();
52             }
53              
54             # NOTE this is only the static functionality.
55             sub can_ssl {
56 11     11 1 16 local $@ = undef;
57 11         22 my ( $ok, $reason ) = ( 1, '' );
58 11 50       20 eval {
59 11         924 require IO::Socket::SSL;
60 11         63963 IO::Socket::SSL->VERSION( 1.42 );
61 11         49 1;
62             } or ( $ok, $reason ) =
63             ( 0, "IO::Socket::SSL 1.42 must be installed for https support\n" );
64             wantarray
65 11 50       92 or return $ok;
66 11         39 return ( $ok, $reason );
67             }
68              
69             sub head {
70 15     15 1 55 my ( $self, $url ) = @_;
71 15         29 return $self->request( HEAD => $url );
72             }
73              
74             sub request {
75 15     15 1 26 my ( $self, undef, $url ) = @_;
76 15   66     59 $self->{status} ||= Storable::retrieve( $self->{fn} );
77 15         1136 my $resp = $self->{status}{$url};
78 15 100 50     60 HASH_REF eq ref $resp
79             or $resp = {
80             status => $resp || 404,
81             };
82 15         41 $resp->{success} = _is_success( $resp->{status} );
83             defined $resp->{reason}
84 15 50       54 or $resp->{reason} = _status_message( $resp->{status} );
85             defined $resp->{url}
86 15 100       38 or $resp->{url} = $url;
87             defined $resp->{content}
88 15 50       35 or $resp->{content} = '';
89 15   50     58 $resp->{headers} ||= {};
90 15         51 return $resp;
91             }
92              
93             sub _is_success {
94 30     30   45 my ( $status ) = @_;
95 30   66     146 return $status >= 200 && $status < 300;
96             }
97              
98             1;
99              
100             __END__