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.54';
3             #ABSTRACT: an extremely minimal FTP client
4              
5 8     8   1229601 use strict;
  8         49  
  8         282  
6 8     8   111 use warnings;
  8         43  
  8         325  
7 8     8   62 use POE qw(Filter::Line Component::Client::DNS);
  8         19  
  8         71  
8 8     8   175000 use Net::IP::Minimal qw(ip_get_version);
  8         1840  
  8         664  
9 8     8   1238 use Test::POE::Client::TCP;
  8         51598  
  8         225  
10 8     8   58 use Carp qw(carp croak);
  8         19  
  8         14962  
11              
12             sub spawn {
13 4     4 1 5537 my $package = shift;
14 4         44 my %opts = @_;
15 4         45 $opts{lc $_} = delete $opts{$_} for keys %opts;
16 4 50       27 croak( "You must provide the 'address' parameter\n" ) unless $opts{address};
17 4 50       36 croak( "You must provide the 'path' parameter\n" ) unless $opts{path};
18 4         38 my $options = delete $opts{options};
19 4 50       20 $opts{prefix} = 'ftp_' unless $opts{prefix};
20 4 50       39 $opts{prefix} .= '_' unless $opts{prefix} =~ /\_$/;
21 4 100       17 $opts{username} = 'anonymous' unless $opts{username};
22 4 100       17 $opts{password} = 'anon@anon.org' unless $opts{password};
23 4         16 my $self = bless \%opts, $package;
24             $self->{session_id} = POE::Session->create(
25             object_states => [
26 4 50       17 $self => { map { ($_,"_$_" ) } qw(cmdc_socket_failed cmdc_input cmdc_disconnected datac_connected datac_disconnected datac_input) },
  24         149  
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         524 return $self;
39             }
40              
41             sub _start {
42 4     4   1440 my ($kernel,$sender,$self) = @_[KERNEL,SENDER,OBJECT];
43 4         28 $self->{session_id} = $_[SESSION]->ID();
44             $self->{cmds} = [
45             [ '220', 'USER ' . $self->{username} ],
46 4         59 [ '331', 'PASS ' . $self->{password} ],
47             # [ '230', 'SIZE ' . $self->{path} ],
48             # [ '213', 'PASV' ],
49             [ '230', 'PASV' ],
50             ];
51 4 50 33     40 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         38 my $sender_id;
55 4 50       24 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         19 $sender_id = $sender->ID();
65             }
66 4         28 $kernel->refcount_increment( $sender_id, __PACKAGE__ );
67 4         195 $self->{sender_id} = $sender_id;
68              
69             $self->{_resolver} = POE::Component::Client::DNS->spawn(
70             Alias => 'Resolver-' . $self->{session_id},
71 4         60 );
72              
73 4         4876 $kernel->yield( '_resolve' );
74 4         351 return;
75             }
76              
77             sub _resolve {
78 4     4   1866 my ($kernel,$self) = @_[KERNEL,OBJECT];
79 4 100       44 if ( ip_get_version( $self->{address} ) ) {
80             # It is an address already
81 3         170 $kernel->yield( '_connect', $self->{address} );
82 3         189 return;
83             }
84             my $resp = $self->{_resolver}->resolve(
85             host => $self->{address},
86 1         45 context => { },
87             event => '_response',
88             );
89 1 50       10001 $kernel->yield( '_response', $resp ) if $resp;
90 1         3 return;
91             }
92              
93             sub _response {
94 1     1   42403 my ($kernel,$self,$resp) = @_[KERNEL,OBJECT,ARG0];
95 1 50 33     17 if ( $resp->{error} and $resp->{error} ne 'NOERROR' ) {
96 1         9 $kernel->yield( 'cmdc_socket_failed', $resp->{error} );
97 1         143 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   579 my ($self,$address) = @_[OBJECT,ARG0];
111             $self->{cmdc} = Test::POE::Client::TCP->spawn(
112             address => $address,
113 3   50     40 port => $self->{port} || 21,
114             prefix => 'cmdc',
115             autoconnect => 1,
116             filter => POE::Filter::Line->new( Literal => "\x0D\x0A" ),
117             );
118 3         3307 return;
119             }
120              
121             sub _cmdc_socket_failed {
122 1     1   338 my ($kernel,$self,@errors) = @_[KERNEL,OBJECT,ARG0..$#_];
123 1         16 $self->_send_event( $self->{prefix} . 'sockerr', @errors );
124 1         11 $kernel->refcount_decrement( $self->{sender_id}, __PACKAGE__ );
125 1 50       77 $self->{cmdc}->shutdown() if $self->{cmdc};
126 1         8 $self->{_resolver}->shutdown();
127 1         414 delete $self->{cmdc};
128 1         4 delete $self->{_resolver};
129 1         7 return;
130             }
131              
132             sub _cmdc_input {
133 33     33   85447 my ($kernel,$self,$input) = @_[KERNEL,OBJECT,ARG0];
134 33 50       114 warn $input, "\n" if $self->{debug};
135 33         166 my ($numeric) = $input =~ /^(\d+)\s+/;
136 33 100       103 return unless $numeric;
137 21         42 my $cmd = shift @{ $self->{cmds} };
  21         54  
138 21 100 66     86 if ( $cmd and $numeric eq $cmd->[0] ) {
139 9 50       45 warn ">>>>$cmd->[1]\n" if $self->{debug};
140 9         40 $self->{cmdc}->send_to_server( $cmd->[1] );
141 9         1523 return;
142             }
143 12 100       48 if ( $numeric eq '227' ) {
144 3         10 my (@ip, @port);
145 3         34 (@ip[0..3], @port[0..1]) = $input =~ /(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/;
146 3         12 my $ip = join '.', @ip;
147 3         15 my $port = $port[0]*256 + $port[1];
148 3         37 $self->{datac} = Test::POE::Client::TCP->spawn(
149             address => $ip,
150             port => $port,
151             autoconnect => 1,
152             prefix => 'datac',
153             );
154 3         2796 return;
155             }
156 9 50       38 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       27 if ( $numeric eq '150' ) {
164             # Transfer in progress
165 3         8 $self->{transfer} = 2;
166             }
167 9 100       26 if ( $numeric eq '226' ) {
168 3         51 $kernel->yield( '_retr_done' );
169             }
170 9 100       213 if ( $numeric eq '221' ) {
171 3         20 $self->{cmdc}->shutdown();
172 3         1688 delete $self->{cmdc};
173             }
174 9         40 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   9000 my ($kernel,$self) = @_[KERNEL,OBJECT];
186 3         23 $self->{cmdc}->send_to_server( 'RETR ' . $self->{path} );
187 3         504 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         14 $kernel->yield( '_retr_done' );
194             }
195 3         211 $self->{datac}->shutdown();
196 3         827 delete $self->{datac};
197 3         13 return;
198             }
199              
200             sub _datac_input {
201 229     229   130763 my ($kernel,$self,$input) = @_[KERNEL,OBJECT,ARG0];
202 229 50       661 warn $input, "\n" if $self->{debug};
203 229         850 $self->_send_event( $self->{prefix} . 'data', $input );
204 229         644 return;
205             }
206              
207             sub _retr_done {
208 6     6   1446 my ($kernel,$self) = @_[KERNEL,OBJECT];
209 6         16 $self->{transfer}--;
210 6 100       23 unless ( $self->{transfer} ) {
211 3         17 $self->_send_event( $self->{prefix} . 'done' );
212 3         17 $kernel->refcount_decrement( $self->{sender_id}, __PACKAGE__ );
213 3 50       164 warn "Transfer complete\n" if $self->{debug};
214 3         19 $self->{cmdc}->send_to_server( 'QUIT' );
215 3         528 return;
216             }
217 3         10 return;
218             }
219              
220             sub _send_event {
221 233     233   422 my $self = shift;
222 233         811 $poe_kernel->post( $self->{sender_id}, @_ );
223 233         23146 return;
224             }
225              
226             'Get me that file, sucker'
227              
228             __END__