File Coverage

blib/lib/POE/Component/SmokeBox/Recent/FTP.pm
Criterion Covered Total %
statement 117 136 86.0
branch 36 56 64.2
condition 5 11 45.4
subroutine 18 19 94.7
pod 1 1 100.0
total 177 223 79.3


line stmt bran cond sub pod time code
1             package POE::Component::SmokeBox::Recent::FTP;
2             $POE::Component::SmokeBox::Recent::FTP::VERSION = '1.52';
3             #ABSTRACT: an extremely minimal FTP client
4              
5 8     8   351551 use strict;
  8         33  
  8         263  
6 8     8   48 use warnings;
  8         24  
  8         256  
7 8     8   50 use POE qw(Filter::Line Component::Client::DNS);
  8         25  
  8         104  
8 8     8   167416 use Net::IP::Minimal qw(ip_get_version);
  8         1649  
  8         561  
9 8     8   1251 use Test::POE::Client::TCP;
  8         49875  
  8         279  
10 8     8   214 use Carp qw(carp croak);
  8         22  
  8         14632  
11              
12             sub spawn {
13 4     4 1 5169 my $package = shift;
14 4         26 my %opts = @_;
15 4         43 $opts{lc $_} = delete $opts{$_} for keys %opts;
16 4 50       23 croak( "You must provide the 'address' parameter\n" ) unless $opts{address};
17 4 50       17 croak( "You must provide the 'path' parameter\n" ) unless $opts{path};
18 4         30 my $options = delete $opts{options};
19 4 50       20 $opts{prefix} = 'ftp_' unless $opts{prefix};
20 4 50       27 $opts{prefix} .= '_' unless $opts{prefix} =~ /\_$/;
21 4 100       18 $opts{username} = 'anonymous' unless $opts{username};
22 4 100       15 $opts{password} = 'anon@anon.org' unless $opts{password};
23 4         15 my $self = bless \%opts, $package;
24             $self->{session_id} = POE::Session->create(
25             object_states => [
26 4 50       15 $self => { map { ($_,"_$_" ) } qw(cmdc_socket_failed cmdc_input cmdc_disconnected datac_connected datac_disconnected datac_input) },
  24         141  
27             $self => [qw(
28             _start
29             _retr_done
30             _resolve
31             _response
32             _connect
33             )],
34             ],
35             heap => $self,
36             ( ref($options) eq 'HASH' ? ( options => $options ) : () ),
37             )->ID();
38 4         546 return $self;
39             }
40              
41             sub _start {
42 4     4   1395 my ($kernel,$sender,$self) = @_[KERNEL,SENDER,OBJECT];
43 4         44 $self->{session_id} = $_[SESSION]->ID();
44             $self->{cmds} = [
45             [ '220', 'USER ' . $self->{username} ],
46 4         51 [ '331', 'PASS ' . $self->{password} ],
47             # [ '230', 'SIZE ' . $self->{path} ],
48             # [ '213', 'PASV' ],
49             [ '230', 'PASV' ],
50             ];
51 4 50 33     27 if ( $kernel == $sender and !$self->{session} ) {
52 0         0 croak "Not called from another POE session and 'session' wasn't set\n";
53             }
54 4         36 my $sender_id;
55 4 50       20 if ( $self->{session} ) {
56 0 0       0 if ( my $ref = $kernel->alias_resolve( $self->{session} ) ) {
57 0         0 $sender_id = $ref->ID();
58             }
59             else {
60 0         0 croak "Could not resolve 'session' to a valid POE session\n";
61             }
62             }
63             else {
64 4         18 $sender_id = $sender->ID();
65             }
66 4         31 $kernel->refcount_increment( $sender_id, __PACKAGE__ );
67 4         173 $self->{sender_id} = $sender_id;
68              
69             $self->{_resolver} = POE::Component::Client::DNS->spawn(
70             Alias => 'Resolver-' . $self->{session_id},
71 4         63 );
72              
73 4         4705 $kernel->yield( '_resolve' );
74 4         289 return;
75             }
76              
77             sub _resolve {
78 4     4   1884 my ($kernel,$self) = @_[KERNEL,OBJECT];
79 4 100       28 if ( ip_get_version( $self->{address} ) ) {
80             # It is an address already
81 3         166 $kernel->yield( '_connect', $self->{address} );
82 3         185 return;
83             }
84             my $resp = $self->{_resolver}->resolve(
85             host => $self->{address},
86 1         33 context => { },
87             event => '_response',
88             );
89 1 50       9807 $kernel->yield( '_response', $resp ) if $resp;
90 1         5 return;
91             }
92              
93             sub _response {
94 1     1   37948 my ($kernel,$self,$resp) = @_[KERNEL,OBJECT,ARG0];
95 1 50 33     12 if ( $resp->{error} and $resp->{error} ne 'NOERROR' ) {
96 1         7 $kernel->yield( 'cmdc_socket_failed', $resp->{error} );
97 1         75 return;
98             }
99 0         0 my @answers = $resp->{response}->answer;
100 0         0 foreach my $answer ( $resp->{response}->answer() ) {
101 0 0       0 next if $answer->type !~ /^A/;
102 0         0 $kernel->yield( '_connect', $answer->rdatastr );
103 0         0 return;
104             }
105 0         0 $kernel->yield( 'cmdc_socket_failed', 'Could not resolve address' );
106 0         0 return;
107             }
108              
109             sub _connect {
110 3     3   576 my ($self,$address) = @_[OBJECT,ARG0];
111             $self->{cmdc} = Test::POE::Client::TCP->spawn(
112             address => $address,
113 3   50     55 port => $self->{port} || 21,
114             prefix => 'cmdc',
115             autoconnect => 1,
116             filter => POE::Filter::Line->new( Literal => "\x0D\x0A" ),
117             );
118 3         3245 return;
119             }
120              
121             sub _cmdc_socket_failed {
122 1     1   207 my ($kernel,$self,@errors) = @_[KERNEL,OBJECT,ARG0..$#_];
123 1         9 $self->_send_event( $self->{prefix} . 'sockerr', @errors );
124 1         4 $kernel->refcount_decrement( $self->{sender_id}, __PACKAGE__ );
125 1 50       42 $self->{cmdc}->shutdown() if $self->{cmdc};
126 1         7 $self->{_resolver}->shutdown();
127 1         248 delete $self->{cmdc};
128 1         3 delete $self->{_resolver};
129 1         3 return;
130             }
131              
132             sub _cmdc_input {
133 33     33   77785 my ($kernel,$self,$input) = @_[KERNEL,OBJECT,ARG0];
134 33 50       102 warn $input, "\n" if $self->{debug};
135 33         166 my ($numeric) = $input =~ /^(\d+)\s+/;
136 33 100       106 return unless $numeric;
137 21         46 my $cmd = shift @{ $self->{cmds} };
  21         55  
138 21 100 66     91 if ( $cmd and $numeric eq $cmd->[0] ) {
139 9 50       36 warn ">>>>$cmd->[1]\n" if $self->{debug};
140 9         41 $self->{cmdc}->send_to_server( $cmd->[1] );
141 9         1593 return;
142             }
143 12 100       43 if ( $numeric eq '227' ) {
144 3         11 my (@ip, @port);
145 3         31 (@ip[0..3], @port[0..1]) = $input =~ /(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/;
146 3         14 my $ip = join '.', @ip;
147 3         14 my $port = $port[0]*256 + $port[1];
148 3         27 $self->{datac} = Test::POE::Client::TCP->spawn(
149             address => $ip,
150             port => $port,
151             autoconnect => 1,
152             prefix => 'datac',
153             );
154 3         2841 return;
155             }
156 9 50       36 if ( $numeric =~ /^5/ ) {
157             # Something went wrong
158 0         0 $self->{cmdc}->send_to_server( 'QUIT' );
159 0         0 $self->_send_event( $self->{prefix} . 'error', $input );
160 0         0 $kernel->refcount_decrement( $self->{sender_id}, __PACKAGE__ );
161 0         0 return;
162             }
163 9 100       30 if ( $numeric eq '150' ) {
164             # Transfer in progress
165 3         10 $self->{transfer} = 2;
166             }
167 9 100       30 if ( $numeric eq '226' ) {
168 3         12 $kernel->yield( '_retr_done' );
169             }
170 9 100       201 if ( $numeric eq '221' ) {
171 3         18 $self->{cmdc}->shutdown();
172 3         1790 delete $self->{cmdc};
173             }
174 9         41 return;
175             }
176              
177             sub _cmdc_disconnected {
178 0     0   0 my ($kernel,$self) = @_[KERNEL,OBJECT];
179 0         0 $self->{cmdc}->shutdown();
180 0         0 delete $self->{cmdc};
181 0         0 return;
182             }
183              
184             sub _datac_connected {
185 3     3   8944 my ($kernel,$self) = @_[KERNEL,OBJECT];
186 3         21 $self->{cmdc}->send_to_server( 'RETR ' . $self->{path} );
187 3         513 return;
188             }
189              
190             sub _datac_disconnected {
191 3     3   273 my ($kernel,$self) = @_[KERNEL,OBJECT];
192 3 50       14 if ( $self->{transfer} ) {
193 3         15 $kernel->yield( '_retr_done' );
194             }
195 3         188 $self->{datac}->shutdown();
196 3         779 delete $self->{datac};
197 3         12 return;
198             }
199              
200             sub _datac_input {
201 229     229   133940 my ($kernel,$self,$input) = @_[KERNEL,OBJECT,ARG0];
202 229 50       653 warn $input, "\n" if $self->{debug};
203 229         960 $self->_send_event( $self->{prefix} . 'data', $input );
204 229         582 return;
205             }
206              
207             sub _retr_done {
208 6     6   1392 my ($kernel,$self) = @_[KERNEL,OBJECT];
209 6         14 $self->{transfer}--;
210 6 100       61 unless ( $self->{transfer} ) {
211 3         20 $self->_send_event( $self->{prefix} . 'done' );
212 3         19 $kernel->refcount_decrement( $self->{sender_id}, __PACKAGE__ );
213 3 50       129 warn "Transfer complete\n" if $self->{debug};
214 3         19 $self->{cmdc}->send_to_server( 'QUIT' );
215 3         514 return;
216             }
217 3         12 return;
218             }
219              
220             sub _send_event {
221 233     233   407 my $self = shift;
222 233         780 $poe_kernel->post( $self->{sender_id}, @_ );
223 233         22690 return;
224             }
225              
226             'Get me that file, sucker'
227              
228             __END__