File Coverage

blib/lib/POE/Component/SmokeBox/Recent/HTTP.pm
Criterion Covered Total %
statement 97 111 87.3
branch 14 28 50.0
condition 10 24 41.6
subroutine 19 20 95.0
pod 1 1 100.0
total 141 184 76.6


line stmt bran cond sub pod time code
1             package POE::Component::SmokeBox::Recent::HTTP;
2             $POE::Component::SmokeBox::Recent::HTTP::VERSION = '1.52';
3             #ABSTRACT: an extremely minimal HTTP client
4              
5 9     9   529921 use strict;
  9         41  
  9         276  
6 9     9   49 use warnings;
  9         25  
  9         310  
7 9     9   50 use POE qw(Filter::HTTP::Parser Component::Client::DNS);
  9         25  
  9         125  
8 9     9   1037041 use Net::IP::Minimal qw(ip_get_version);
  9         8088  
  9         1061  
9 9     9   5855 use Test::POE::Client::TCP;
  9         198108  
  9         366  
10 9     9   91 use Carp qw(carp croak);
  9         21  
  9         535  
11 9     9   74 use HTTP::Request;
  9         31  
  9         357  
12 9     9   64 use URI;
  9         26  
  9         13186  
13              
14             sub spawn {
15 6     6 1 34157 my $package = shift;
16 6         32 my %opts = @_;
17 6         53 $opts{lc $_} = delete $opts{$_} for keys %opts;
18             croak( "You must provide the 'uri' parameter and it must a URI object and a supported scheme\n" )
19             unless $opts{uri} and $opts{uri}->isa('URI')
20             and $opts{uri}->scheme and $opts{uri}->scheme =~ /^http$/
21 6 50 33     53 and $opts{uri}->host;
      33        
      33        
      33        
22 6         989 my $options = delete $opts{options};
23 6 50       45 $opts{prefix} = 'http_' unless $opts{prefix};
24 6 50       60 $opts{prefix} .= '_' unless $opts{prefix} =~ /\_$/;
25 6         35 my $self = bless \%opts, $package;
26             $self->{session_id} = POE::Session->create(
27             object_states => [
28 6 50       27 $self => { map { ($_,"_$_" ) } qw(web_socket_failed web_connected web_input web_disconnected) },
  24         212  
29             $self => [qw(
30             _start
31             _resolve
32             _response
33             _connect
34             _shutdown
35             _timeout
36             )],
37             ],
38             heap => $self,
39             ( ref($options) eq 'HASH' ? ( options => $options ) : () ),
40             )->ID();
41 6         897 return $self;
42             }
43              
44             sub _start {
45 6     6   2259 my ($kernel,$sender,$self) = @_[KERNEL,SENDER,OBJECT];
46 6         85 $self->{session_id} = $_[SESSION]->ID();
47 6 50 33     82 if ( $kernel == $sender and !$self->{session} ) {
48 0         0 croak "Not called from another POE session and 'session' wasn't set\n";
49             }
50 6         17 my $sender_id;
51 6 50       28 if ( $self->{session} ) {
52 0 0       0 if ( my $ref = $kernel->alias_resolve( $self->{session} ) ) {
53 0         0 $sender_id = $ref->ID();
54             }
55             else {
56 0         0 croak "Could not resolve 'session' to a valid POE session\n";
57             }
58             }
59             else {
60 6         32 $sender_id = $sender->ID();
61             }
62 6         49 $kernel->refcount_increment( $sender_id, __PACKAGE__ );
63 6         268 $self->{sender_id} = $sender_id;
64              
65             $self->{_resolver} = POE::Component::Client::DNS->spawn(
66             Alias => 'Resolver-' . $self->{session_id},
67 6         111 );
68              
69 6         7163 $self->{address} = $self->{uri}->host;
70 6         265 $self->{port} = $self->{uri}->port;
71              
72 6         204 $kernel->yield( '_resolve' );
73 6         458 return;
74             }
75              
76             sub _resolve {
77 6     6   3612 my ($kernel,$self) = @_[KERNEL,OBJECT];
78 6 100       55 if ( ip_get_version( $self->{address} ) ) {
79             # It is an address already
80 5         362 $kernel->yield( '_connect', $self->{address} );
81 5         338 return;
82             }
83             my $resp = $self->{_resolver}->resolve(
84             host => $self->{address},
85 1         45 context => { },
86             event => '_response',
87             );
88 1 50       9816 $kernel->yield( '_response', $resp ) if $resp;
89 1         11 return;
90             }
91              
92             sub _response {
93 1     1   36882 my ($kernel,$self,$resp) = @_[KERNEL,OBJECT,ARG0];
94 1 50 33     11 if ( $resp->{error} and $resp->{error} ne 'NOERROR' ) {
95 1         7 $kernel->yield( 'web_socket_failed', $resp->{error} );
96 1         75 return;
97             }
98 0         0 my @answers = $resp->{response}->answer;
99 0         0 foreach my $answer ( $resp->{response}->answer() ) {
100 0 0       0 next if $answer->type !~ /^A/;
101 0         0 $kernel->yield( '_connect', $answer->rdatastr );
102 0         0 return;
103             }
104 0         0 $kernel->yield( 'web_socket_failed', 'Could not resolve address' );
105 0         0 return;
106             }
107              
108             sub _connect {
109 5     5   1581 my ($self,$address) = @_[OBJECT,ARG0];
110             $self->{web} = Test::POE::Client::TCP->spawn(
111             address => $address,
112 5   50     84 port => $self->{port} || 80,
113             prefix => 'web',
114             autoconnect => 1,
115             filter => POE::Filter::HTTP::Parser->new( type => 'client' ),
116             );
117 5         5545 return;
118             }
119              
120             sub _web_connected {
121 5     5   18917 my $self = $_[OBJECT];
122 5         59 my $req = HTTP::Request->new( GET => $self->{uri}->path_query );
123 5         887 $req->protocol( 'HTTP/1.1' );
124 5 50       133 $req->header( 'Host', $self->{address} . ( $self->{port} ne '80' ? ":$self->{port}" : '' ) );
125 5         734 $req->user_agent( sprintf( 'POE-Component-SmokeBox-Recent-HTTP/%s (perl; N; POE; en; rv:%f)', $POE::Component::SmokeBox::Recent::HTTP::VERSION, $POE::Component::SmokeBox::Recent::HTTP::VERSION ) );
126 5         404 $self->{web}->send_to_server( $req );
127 5   100     2176 $poe_kernel->delay( '_timeout', $self->{timeout} || 60 );
128 5         558 return;
129             }
130              
131             sub _timeout {
132 1     1   10010220 my ($kernel,$self) = @_[KERNEL,OBJECT];
133 1   50     25 $self->_send_event( $self->{prefix} . 'timeout', "Timed out connection after " . ( $self->{timeout} || 60 ) . " seconds." );
134 1         7 $kernel->refcount_decrement( $self->{sender_id}, __PACKAGE__ );
135 1         76 $kernel->yield( '_shutdown' );
136 1         93 return;
137             }
138              
139             sub _web_socket_failed {
140 1     1   198 my ($kernel,$self,@errors) = @_[KERNEL,OBJECT,ARG0..$#_];
141 1         10 $self->_send_event( $self->{prefix} . 'sockerr', @errors );
142 1         4 $kernel->refcount_decrement( $self->{sender_id}, __PACKAGE__ );
143 1         43 $kernel->yield( '_shutdown' );
144 1         67 return;
145             }
146              
147             sub _web_input {
148 4     4   26617 my ($kernel,$self,$resp) = @_[KERNEL,OBJECT,ARG0];
149 4         23 $kernel->delay( '_timeout' );
150 4         438 $self->_send_event( $self->{prefix} . 'response', $resp );
151 4         22 $kernel->refcount_decrement( $self->{sender_id}, __PACKAGE__ );
152 4         228 $self->{web}->shutdown();
153 4         2930 delete $self->{web};
154 4         15 return;
155             }
156              
157             sub _web_disconnected {
158 0     0   0 my ($kernel,$self) = @_[KERNEL,OBJECT];
159 0         0 $kernel->yield( '_shutdown' );
160 0         0 return;
161             }
162              
163             sub _send_event {
164 6     6   30 my $self = shift;
165 6         38 $poe_kernel->post( $self->{sender_id}, @_ );
166 6         706 return;
167             }
168              
169             sub _shutdown {
170 2     2   2137 my $self = $_[OBJECT];
171 2         11 $poe_kernel->delay( '_timeout' );
172 2 100       153 $self->{web}->shutdown() if $self->{web};
173 2 50       832 $self->{_resolver}->shutdown() if $self->{_resolver};
174 2         444 delete $self->{web};
175 2         7 delete $self->{_resolver};
176 2         7 return;
177             }
178              
179             'Get me that file, sucker'
180              
181             __END__