File Coverage

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


line stmt bran cond sub pod time code
1             package POE::Component::SmokeBox::Recent::HTTP;
2             $POE::Component::SmokeBox::Recent::HTTP::VERSION = '1.50';
3             #ABSTRACT: an extremely minimal HTTP client
4              
5 9     9   259952 use strict;
  9         15  
  9         218  
6 9     9   28 use warnings;
  9         9  
  9         233  
7 9     9   28 use POE qw(Filter::HTTP::Parser Component::Client::DNS);
  9         8  
  9         57  
8 9     9   661336 use Net::IP::Minimal qw(ip_get_version);
  9         4837  
  9         514  
9 9     9   4233 use Test::POE::Client::TCP;
  9         127379  
  9         231  
10 9     9   103 use Carp qw(carp croak);
  9         12  
  9         394  
11 9     9   35 use HTTP::Request;
  9         10  
  9         159  
12 9     9   30 use URI;
  9         9  
  9         8068  
13              
14             sub spawn {
15 6     6 1 22832 my $package = shift;
16 6         18 my %opts = @_;
17 6         43 $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     30 and $opts{uri}->host;
      33        
      33        
      33        
22 6         616 my $options = delete $opts{options};
23 6 50       26 $opts{prefix} = 'http_' unless $opts{prefix};
24 6 50       27 $opts{prefix} .= '_' unless $opts{prefix} =~ /\_$/;
25 6         19 my $self = bless \%opts, $package;
26             $self->{session_id} = POE::Session->create(
27             object_states => [
28 6 50       18 $self => { map { ($_,"_$_" ) } qw(web_socket_failed web_connected web_input web_disconnected) },
  24         120  
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         462 return $self;
42             }
43              
44             sub _start {
45 6     6   1209 my ($kernel,$sender,$self) = @_[KERNEL,SENDER,OBJECT];
46 6         17 $self->{session_id} = $_[SESSION]->ID();
47 6 50 33     47 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         7 my $sender_id;
51 6 50       18 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         15 $sender_id = $sender->ID();
61             }
62 6         35 $kernel->refcount_increment( $sender_id, __PACKAGE__ );
63 6         134 $self->{sender_id} = $sender_id;
64              
65             $self->{_resolver} = POE::Component::Client::DNS->spawn(
66             Alias => 'Resolver-' . $self->{session_id},
67 6         63 );
68              
69 6         4100 $self->{address} = $self->{uri}->host;
70 6         154 $self->{port} = $self->{uri}->port;
71              
72 6         132 $kernel->yield( '_resolve' );
73 6         242 return;
74             }
75              
76             sub _resolve {
77 6     6   1722 my ($kernel,$self) = @_[KERNEL,OBJECT];
78 6 100       33 if ( ip_get_version( $self->{address} ) ) {
79             # It is an address already
80 5         190 $kernel->yield( '_connect', $self->{address} );
81 5         164 return;
82             }
83             my $resp = $self->{_resolver}->resolve(
84             host => $self->{address},
85 1         31 context => { },
86             event => '_response',
87             );
88 1 50       4139 $kernel->yield( '_response', $resp ) if $resp;
89 1         3 return;
90             }
91              
92             sub _response {
93 1     1   89260 my ($kernel,$self,$resp) = @_[KERNEL,OBJECT,ARG0];
94 1 50 33     6 if ( $resp->{error} and $resp->{error} ne 'NOERROR' ) {
95 0         0 $kernel->yield( 'web_socket_failed', $resp->{error} );
96 0         0 return;
97             }
98 1         4 my @answers = $resp->{response}->answer;
99 1         26 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 1         7 $kernel->yield( 'web_socket_failed', 'Could not resolve address' );
105 1         42 return;
106             }
107              
108             sub _connect {
109 5     5   441 my ($self,$address) = @_[OBJECT,ARG0];
110             $self->{web} = Test::POE::Client::TCP->spawn(
111             address => $address,
112 5   50     56 port => $self->{port} || 80,
113             prefix => 'web',
114             autoconnect => 1,
115             filter => POE::Filter::HTTP::Parser->new( type => 'client' ),
116             );
117 5         3043 return;
118             }
119              
120             sub _web_connected {
121 5     5   8515 my $self = $_[OBJECT];
122 5         64 my $req = HTTP::Request->new( GET => $self->{uri}->path );
123 5         540 $req->protocol( 'HTTP/1.1' );
124 5 50       106 $req->header( 'Host', $self->{address} . ( $self->{port} ne '80' ? ":$self->{port}" : '' ) );
125 5         464 $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         250 $self->{web}->send_to_server( $req );
127 5   100     1206 $poe_kernel->delay( '_timeout', $self->{timeout} || 60 );
128 5         375 return;
129             }
130              
131             sub _timeout {
132 1     1   10010192 my ($kernel,$self) = @_[KERNEL,OBJECT];
133 1   50     24 $self->_send_event( $self->{prefix} . 'timeout', "Timed out connection after " . ( $self->{timeout} || 60 ) . " seconds." );
134 1         6 $kernel->refcount_decrement( $self->{sender_id}, __PACKAGE__ );
135 1         58 $kernel->yield( '_shutdown' );
136 1         68 return;
137             }
138              
139             sub _web_socket_failed {
140 1     1   134 my ($kernel,$self,@errors) = @_[KERNEL,OBJECT,ARG0..$#_];
141 1         6 $self->_send_event( $self->{prefix} . 'sockerr', @errors );
142 1         2 $kernel->refcount_decrement( $self->{sender_id}, __PACKAGE__ );
143 1         20 $kernel->yield( '_shutdown' );
144 1         32 return;
145             }
146              
147             sub _web_input {
148 4     4   14849 my ($kernel,$self,$resp) = @_[KERNEL,OBJECT,ARG0];
149 4         15 $kernel->delay( '_timeout' );
150 4         218 $self->_send_event( $self->{prefix} . 'response', $resp );
151 4         14 $kernel->refcount_decrement( $self->{sender_id}, __PACKAGE__ );
152 4         133 $self->{web}->shutdown();
153 4         1462 delete $self->{web};
154 4         10 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   20 my $self = shift;
165 6         21 $poe_kernel->post( $self->{sender_id}, @_ );
166 6         423 return;
167             }
168              
169             sub _shutdown {
170 2     2   1820 my $self = $_[OBJECT];
171 2         10 $poe_kernel->delay( '_timeout' );
172 2 100       124 $self->{web}->shutdown() if $self->{web};
173 2 50       718 $self->{_resolver}->shutdown() if $self->{_resolver};
174 2         313 delete $self->{web};
175 2         4 delete $self->{_resolver};
176 2         6 return;
177             }
178              
179             'Get me that file, sucker'
180              
181             __END__