show scheduled and burned columns
[BackupPC.git] / lib / Net / FTP / AutoReconnect.pm
1 package Net::FTP::AutoReconnect;
2 our $VERSION = '0.2';
3
4 use warnings;
5 use strict;
6
7 use Net::FTP;
8
9 =head1 NAME
10
11 Net::FTP::AutoReconnect - FTP client class with automatic reconnect on failure
12
13 =head1 SYNOPSIS
14
15 C<Net::FTP::AutoReconnect> is a wrapper module around C<Net::FTP>.
16 For many commands, if anything goes wrong on the first try, it tries
17 to disconnect and reconnect to the server, restore the state to the
18 same as it was when the command was executed, then execute it again.
19 The state includes login credentials, authorize credentials, transfer
20 mode (ASCII or binary), current working directory, and any restart,
21 passive, or port commands sent.
22
23 =head1 DESCRIPTION
24
25 The goal of this method is to hide some implementation details of FTP
26 server systems from the programmer.  In particular, many FTP systems
27 will automatically disconnect a user after a relatively short idle
28 time or after a transfer is aborted.  In this case,
29 C<Net::FTP::AutoReconnect> will simply reconnect, send the commands
30 necessary to return your session to its previous state, then resend
31 the command.  If that fails, it will return the error.
32
33 It makes no effort to determine what sorts of errors are likely to
34 succeed when they're retried.  Partly that's because it's hard to
35 know; if you're retreiving a file from an FTP site with several
36 mirrors and the file is not found, for example, maybe on the next try
37 you'll connect to a different server and find it.  But mostly it's
38 from laziness; if you have some good ideas about how to determine when
39 to retry and when not to bother, by all means send patches.
40
41 This module contains an instance of C<Net::FTP>, which it passes most
42 method calls along to.
43
44 These methods also record their state: C<alloc>, C<ascii>,
45 C<authorize>, C<binary>, C<cdup>, C<cwd>, C<hash>,
46 C<login>,C<restart>, C<pasv>, C<port>.  Directory changing commands
47 execute a C<pwd> afterwards and store their new working directory.
48
49 These methods are automatically retried: C<alloc>, C<appe>, C<append>,
50 C<ascii>, C<binary>, C<cdup>, C<cwd>, C<delete>, C<dir>, C<get>,
51 C<list>, C<ls>, C<mdtm>, C<mkdir>, C<nlst>, C<pasv>, C<port>, C<put>,
52 C<put_unique>, C<pwd>, C<rename>, C<retr>, C<rmdir>, C<size>, C<stou>,
53 C<supported>.
54
55 These methods are tried just once: C<abort>, C<authorize>, C<hash>,
56 C<login>, C<pasv_xfer>, C<pasv_xfer_unique>, C<pasv_wait>, C<quit>,
57 C<restart>, C<site>, C<unique_name>.  From C<Net::Cmd>: C<code>,
58 C<message>, C<ok>, C<status>.  C<restart> doesn't actually send any
59 FTP commands (they're sent along with the command they apply to),
60 which is why it's not restarted.
61
62 Any other commands are unimplemented (or possibly misdocumented); if I
63 missed one you'd like, please send a patch.
64
65 =head2 CONSTRUCTOR
66
67 =head3 new
68
69 All parameters are passed along verbatim to C<Net::FTP>, as well as
70 stored in case we have to reconnect.
71
72 =cut
73   ;
74
75 sub new {
76   my $self = {};
77   my $class = shift;
78   bless $self,$class;
79
80   $self->{newargs} = \@_;
81   $self->reconnect();
82
83   $self;
84 }
85
86 =head2 METHODS
87
88 Most of the methods are those of L<Net::FTP|Net::FTP>.  One additional
89 method is available:
90
91 =head3 reconnect()
92
93 Abandon the current FTP connection and create a new one, restoring all
94 the state we can.
95
96 =cut
97   ;
98
99 sub reconnect
100 {
101   my $self = shift;
102
103   warn "Reconnecting!\n"
104     if ($ENV{DEBUG});
105
106   $self->{ftp} = Net::FTP->new(@{$self->{newargs}})
107     or die "Couldn't create new FTP object\n";
108
109   if ($self->{login})
110   {
111     $self->{ftp}->login(@{$self->{login}});
112   }
113   if ($self->{authorize})
114   {
115     $self->{ftp}->authorize(@{$self->{authorize}});
116   }
117   if ($self->{mode})
118   {
119     if ($self->{mode} eq 'ascii')
120     {
121       $self->{ftp}->ascii();
122     }
123     else
124     {
125       $self->{ftp}->binary();
126     }
127   }
128   if ($self->{cwd})
129   {
130     $self->{ftp}->cwd($self->{cwd});
131   }
132   if ($self->{hash})
133   {
134     $self->{ftp}->hash(@{$self->{hash}});
135   }
136   if ($self->{restart})
137   {
138     $self->{ftp}->restart(@{$self->{restart}});
139   }
140   if ($self->{alloc})
141   {
142     $self->{ftp}->restart(@{$self->{alloc}});
143   }
144   if ($self->{pasv})
145   {
146     $self->{ftp}->pasv(@{$self->{pasv}});
147   }
148   if ($self->{port})
149   {
150     $self->{ftp}->port(@{$self->{port}});
151   }
152 }
153
154 sub _auto_reconnect
155 {
156   my $self = shift;
157   my($code)=@_;
158
159   my $ret = $code->();
160   if (!defined($ret))
161   {
162     $self->reconnect();
163     $ret = $code->();
164   }
165   $ret;
166 }
167
168 sub _after_pcmd
169 {
170   my $self = shift;
171   my($r) = @_;
172   if ($r)
173   {
174     # succeeded
175     delete $self->{port};
176     delete $self->{pasv};
177     delete $self->{restart};
178     delete $self->{alloc};
179   }
180   $r;
181 }
182
183
184 sub login
185 {
186   my $self = shift;
187
188   $self->{login} = \@_;
189   $self->{ftp}->login(@_);
190 }
191
192 sub authorize
193 {
194   my $self = shift;
195   $self->{authorize} = \@_;
196   $self->{ftp}->authorize(@_);
197 }
198
199 sub site
200 {
201   my $self = shift;
202   $self->{ftp}->site(@_);
203 }
204
205 sub ascii
206 {
207   my $self = shift;
208   $self->{mode} = 'ascii';
209   $self->_auto_reconnect(sub { $self->{ftp}->ascii() });
210 }
211
212 sub binary
213 {
214   my $self = shift;
215   $self->{mode} = 'binary';
216   $self->_auto_reconnect(sub { $self->{ftp}->binary() });
217 }
218
219 sub rename
220 {
221   my $self = shift;
222   my @a = @_;
223   $self->_auto_reconnect(sub { $self->{ftp}->rename(@a) });
224 }
225
226 sub delete
227 {
228   my $self = shift;
229   my @a = @_;
230   $self->_auto_reconnect(sub { $self->{ftp}->delete(@a) });
231 }
232
233 sub cwd
234 {
235   my $self = shift;
236   my @a = @_;
237   my $ret = $self->_auto_reconnect(sub { $self->{ftp}->cwd(@a) });
238   if (defined($ret))
239   {
240     $self->{cwd} = $self->{ftp}->pwd()
241       or die "Couldn't get directory after cwd\n";
242   }
243   $ret;
244 }
245
246 sub cdup
247 {
248   my $self = shift;
249   my @a = @_;
250   my $ret = $self->_auto_reconnect(sub { $self->{ftp}->cdup(@a) });
251   if (defined($ret))
252   {
253     $self->{cwd} = $self->{ftp}->pwd()
254       or die "Couldn't get directory after cdup\n";
255   }
256   $ret;
257 }
258
259 sub pwd
260 {
261   my $self = shift;
262   my @a = @_;
263   $self->_auto_reconnect(sub { $self->{ftp}->pwd(@a) });
264 }
265
266 sub rmdir
267 {
268   my $self = shift;
269   my @a = @_;
270   $self->_auto_reconnect(sub { $self->{ftp}->rmdir(@a) });
271 }
272
273 sub mkdir
274 {
275   my $self = shift;
276   my @a = @_;
277   $self->_auto_reconnect(sub { $self->{ftp}->mkdir(@a) });
278 }
279
280 sub ls
281 {
282   my $self = shift;
283   my @a = @_;
284   my $ret = $self->_auto_reconnect(sub { $self->{ftp}->ls(@a) });
285   return $ret ? (wantarray ? @$ret : $ret) : undef;
286 }
287
288 sub dir
289 {
290   my $self = shift;
291   my @a = @_;
292   my $ret = $self->_auto_reconnect(sub { $self->{ftp}->dir(@a) });
293   return $ret ? (wantarray ? @$ret : $ret) : undef;
294 }
295
296 sub restart
297 {
298   my $self = shift;
299   my @a = @_;
300   $self->{restart} = \@a;
301   $self->{ftp}->restart(@_);
302 }
303
304 sub retr
305 {
306   my $self = shift;
307   my @a = @_;
308   $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->retr(@a) }));
309 }
310
311 sub get
312 {
313   my $self = shift;
314   my @a = @_;
315   $self->_auto_reconnect(sub { $self->{ftp}->get(@a) });
316 }
317
318 sub mdtm
319 {
320   my $self = shift;
321   my @a = @_;
322   $self->_auto_reconnect(sub { $self->{ftp}->mdtm(@a) });
323 }
324
325 sub size
326 {
327   my $self = shift;
328   my @a = @_;
329   $self->_auto_reconnect(sub { $self->{ftp}->size(@a) });
330 }
331
332 sub abort
333 {
334   my $self = shift;
335   $self->{ftp}->abort();
336 }
337
338 sub quit
339 {
340   my $self = shift;
341   $self->{ftp}->quit();
342 }
343
344 sub hash
345 {
346   my $self = shift;
347   my @a = @_;
348   $self->{hash} = \@a;
349   $self->{ftp}->hash(@_);
350 }
351
352 sub alloc
353 {
354   my $self = shift;
355   my @a = @_;
356   $self->{alloc} = \@a;
357   $self->_auto_reconnect(sub { $self->{ftp}->alloc(@a) });
358 }
359
360 sub put
361 {
362   my $self = shift;
363   my @a = @_;
364   $self->_auto_reconnect(sub { $self->{ftp}->put(@a) });
365 }
366
367 sub put_unique
368 {
369   my $self = shift;
370   my @a = @_;
371   $self->_auto_reconnect(sub { $self->{ftp}->put_unique(@a) });
372 }
373
374 sub append
375 {
376   my $self = shift;
377   my @a = @_;
378   $self->_auto_reconnect(sub { $self->{ftp}->append(@a) });
379 }
380
381 sub unique_name
382 {
383   my $self = shift;
384   $self->{ftp}->unique_name(@_);
385 }
386
387 sub supported
388 {
389   my $self = shift;
390   my @a = @_;
391   $self->_auto_reconnect(sub { $self->{ftp}->supported(@a) });
392 }
393
394 sub port
395 {
396   my $self = shift;
397   my @a = @_;
398   $self->{port} = \@a;
399   $self->_auto_reconnect(sub { $self->{ftp}->port(@a) });
400 }
401
402 sub pasv
403 {
404   my $self = shift;
405   my @a = @_;
406   $self->{pasv} = \@a;
407   $self->_auto_reconnect(sub { $self->{ftp}->pasv(@a) });
408 }
409
410 sub nlst
411 {
412   my $self = shift;
413   my @a = @_;
414   $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->nlst(@a) }));
415 }
416
417 sub stou
418 {
419   my $self = shift;
420   my @a = @_;
421   $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->stou(@a) }));
422 }
423
424 sub appe
425 {
426   my $self = shift;
427   my @a = @_;
428   $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->appe(@a) }));
429 }
430
431 sub list
432 {
433   my $self = shift;
434   my @a = @_;
435   $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->list(@a) }));
436 }
437
438 sub pasv_xfer
439 {
440   my $self = shift;
441   $self->{ftp}->pasv_xfer(@_);
442 }
443
444 sub pasv_xfer_unique
445 {
446   my $self = shift;
447   $self->{ftp}->pasv_xfer_unique(@_);
448 }
449
450 sub pasv_wait
451 {
452   my $self = shift;
453   $self->{ftp}->pasv_wait(@_);
454 }
455
456 sub message
457 {
458   my $self = shift;
459   $self->{ftp}->message(@_);
460 }
461
462 sub code
463 {
464   my $self = shift;
465   $self->{ftp}->code(@_);
466 }
467
468 sub ok
469 {
470   my $self = shift;
471   $self->{ftp}->ok(@_);
472 }
473
474 sub status
475 {
476   my $self = shift;
477   $self->{ftp}->status(@_);
478 }
479
480 =head1 AUTHOR
481
482 Scott Gifford <sgifford@suspectclass.com>
483
484 =head1 BUGS
485
486 We should really be smarter about when to retry.
487
488 We shouldn't be hardwired to use C<Net::FTP>, but any FTP-compatible
489 class; that would allow all modules similar to this one to be chained
490 together.
491
492 Much of this is only lightly tested; it's hard to find an FTP server
493 unreliable enough to test all aspects of it.  It's mostly been tested
494 with a server that dicsonnects after an aborted transfer, and the
495 module seems to work OK.
496
497 =head1 SEE ALSO
498
499 L<Net::FTP>.
500
501 =head1 COPYRIGHT
502
503 Copyright (c) 2006 Scott Gifford. All rights reserved.  This program
504 is free software; you can redistribute it and/or modify it under the
505 same terms as Perl itself.
506
507 =cut
508
509 1;