File Coverage

inc/Mock/HTTP/Tiny.pm
Criterion Covered Total %
statement 48 50 96.0
branch 14 20 70.0
condition 8 16 50.0
subroutine 14 14 100.0
pod 4 4 100.0
total 88 104 84.6


line stmt bran cond sub pod time code
1             package HTTP::Tiny;
2              
3 1     1   14 use 5.008;
  1         3  
4              
5 1     1   3 use strict;
  1         2  
  1         16  
6 1     1   3 use warnings;
  1         1  
  1         16  
7              
8 1     1   4 use Carp;
  1         1  
  1         114  
9 1     1   683 use Storable ();
  1         3153  
  1         37  
10              
11             our $VERSION = '0.010';
12              
13 1     1   5 use constant HASH_REF => ref {};
  1         2  
  1         103  
14              
15             BEGIN {
16 1     1   3 local $@ = undef;
17              
18             eval {
19 1         636 require HTTP::Status;
20 0         0 *_status_message = \&HTTP::Status::status_message;
21 0         0 1;
22             } or *_status_message = sub {
23 15     15   43 my ( $status ) = @_;
24 15 100       21 return _is_success( $status ) ? 'OK' : 'Failed';
25 1 50       1 };
26             }
27              
28             sub new {
29 36     36 1 66 my ( $class, %arg ) = @_;
30             defined $arg{fn}
31 36 50       89 or $arg{fn} = 't/data/_http/status';
32 36 100       65 if ( defined $arg{agent} ) {
33             $arg{agent} =~ m/ \s \z /smx
34 12 50       39 and $arg{agent} .= $class->_default_agent();
35             } else {
36 24         44 $arg{agent} = $class->_default_agent();
37             }
38 36   33     170 return bless \%arg, ref $class || $class;
39             }
40              
41             sub agent {
42 24     24 1 32 my ( $invocant ) = @_;
43 24 50       39 ref $invocant
44             or return $invocant->_default_agent();
45 24         80 return $invocant->{agent};
46             }
47              
48             sub _default_agent {
49 24     24   78 my ( $self ) = @_;
50 24   33     149 ( my $agent = ref $self || $self ) =~ s/ :: /-/smxg;
51 24         228 return join '/', "Mock $agent", $self->VERSION();
52             }
53              
54             sub head {
55 15     15 1 45 my ( $self, $url ) = @_;
56 15         21 return $self->request( HEAD => $url );
57             }
58              
59             sub request {
60 15     15 1 23 my ( $self, undef, $url ) = @_;
61 15   66     42 $self->{status} ||= Storable::retrieve( $self->{fn} );
62 15         1000 my $resp = $self->{status}{$url};
63 15 100 50     54 HASH_REF eq ref $resp
64             or $resp = {
65             status => $resp || 404,
66             };
67 15         30 $resp->{success} = _is_success( $resp->{status} );
68             defined $resp->{reason}
69 15 50       45 or $resp->{reason} = _status_message( $resp->{status} );
70             defined $resp->{url}
71 15 100       27 or $resp->{url} = $url;
72             defined $resp->{content}
73 15 50       32 or $resp->{content} = '';
74 15   50     44 $resp->{headers} ||= {};
75 15         44 return $resp;
76             }
77              
78             sub _is_success {
79 30     30   43 my ( $status ) = @_;
80 30   66     149 return $status >= 200 && $status < 300;
81             }
82              
83             1;
84              
85             __END__