On Sun, 2006-05-14 at 21:45 +1000, Ken Foskey wrote:
> I am trying to transfer across a link that is unreliable. (OK it is
> reliable but it does break occasionally.)
I found the solution to this in an earlier email took the code and
created a module for myself and here is my module and test script (so
this is how testing is done re my earlier email)...
I am not really happy with the error management in the module.
How would you attack error management?
What I am thinking is to have the module process each loop and call a
subroutine passed by the caller if it fails, the user of the module for
management could then decide what they want to do or simply do nothing.
I do not know how to do this, or even if this is a good idea.
Code is LGPL so please feel free.
----
#!/usr/bin/perl -w
# vi:set sw=4 ts=4 et cin:
# $Id: ftp_retry.pm,v 1.4 2006/05/17 05:04:21 foskey Exp $
=head1 NAME
ftp_retry.pm
=head1 DESCRIPTION
Deliver a file to a host that may or may not be disconnected at the
time.
Uses a back off process to retry with increasing delay between tries.
ftp_upload( { host=>remote hostname,
user=> user on remote machine (if empty will use netrc or
fail)
password=> password on remote machine,
(not needed if you are using netrc,
you will encrypt this somehow wont you...)
local_file=> filename on this server
remote_file=> filename on remote server
(default basename of local_file)
directory=> optional directory on remote server to change
to
retries=> # of retries, default 3.
delay=> # of seconds (default 10 minutes)
});
=head1 TODO
Better documentation...
Use alert module instead of simply printing error message.
=head1 AUTHOR
Ken Foskey
=head1 COPYRIGHT
Copyright 2006 GPL
=cut
use warnings;
use strict;
package ftp_retry;
use Net::FTP;
use File::Basename;
require 'Exporter.pm';
use vars qw( $VERSION
@ISA
@EXPORT
);
@ISA = qw(Exporter);
@EXPORT = qw(&ftp_upload);
our %EXPORT_TAGS = (CONSTANTS => [qw()]);
Exporter::export_ok_tags('CONSTANTS');
$VERSION = '$Revision: 1.4 $';
sub ftp_upload
{
my $config = shift;
# defaults
$config->{retries} = 3 if( ! $config->{retries} );
$config->{delay} = 10*60 if( ! $config->{delay}); # 10 minutes
my $try = 0;
while ( $try < $config->{retries} ) {
# back off default is 10 mins, then 20, then 30 for 1 hour
retry.
# positional, must be before increment of try...
sleep( $try * $config->{delay} );
$try++;
print "Uploading ($try/$config->{retries})...\n";
eval {
my $ftp = Net::FTP->new($config->{host}, Debug => 0)
or die "Cannot connect to $config->{host}: $@";
if( $config->{user} ) {
$ftp->login( $config->{user}, $config->{password} )
or die "Cannot login ", $ftp->message;
}
else {
$ftp->login()
or die "Cannot login ", $ftp->message;
}
if( $config->{directory} ) {
$ftp->cwd( $config->{directory} )
or die "Cannot change working directory ",
$ftp->message;
}
if( $config->{remote_file} ) {
$ftp->put( $config->{local_file},
$config->{remote_file} )
or die "put failed ", $ftp->message;
}
else {
$ftp->put( $config->{local_file},
basename($config->{local_file}) )
or die "put failed ", $ftp->message;
}
$ftp->quit;
};
$@ ? print $@ : return 1;
}
print "Failed after $try attempt(s)\n";
return 0;
}
--------------------
#!/usr/bin/perl -w
# vi:set sw=4 ts=4 et cin:
# $Id: ftp_retry.t,v 1.4 2006/05/17 05:47:10 foskey Exp $
=head1 NAME
ftp_retry.t
=head1 DESCRIPTION
Does a few FTP commands and tests backoff...
=HEAD1 AUTHOR
Ken Foskey
=cut
# Libraries
use strict;
use warnings;
use Test::More;
use lib "/apps/bin/modules";
use ftp_retry;
plan( tests=>7 ); ## number of test coded.
my $user = 'foskey';
my $password = 'password';
ok( ftp_upload( {host=>'localhost',
user=>$user,
password=>$password,
local_file=>'/apps/bin/modules/ftp_retry.pm',
retries=>1,
delay=>1 }), "Testing basic simple transfer" );
ok( ftp_upload( {host=>'localhost',
local_file=>'/apps/bin/modules/ftp_retry.pm',
retries=>1,
delay=>1 }), "Testing basic netrc transfer" );
ok( ! ftp_upload( {host=>'localhost',
local_file=>'/apps/bin/modules/ftp_retry.pm',
directory=>'/really/stupid/directory',
retries=>1,
delay=>1 }), "Testing bad directory" );
ok( ! ftp_upload( {host=>'localhost',
local_file=>'/apps/bin/modules/ftp_retry.pm',
directory=>'/home',
retries=>1,
delay=>1 }), "sensible directory, no security" );
ok( ftp_upload( {host=>'localhost',
local_file=>'/apps/bin/modules/ftp_retry.pm',
directory=>"/home/$user",
retries=>1,
delay=>1 }), "sensible directory, with security" );
ok( ! ftp_upload( {host=>'xnoserverx',
local_file=>'/apps/bin/modules/ftp_retry.pm',
retries=>1,
delay=>1 }), "Testing failed transfer" );
ok( ! ftp_upload( {host=>'xnoserverx',
local_file=>'/apps/bin/modules/ftp_retry.pm',
retries=>2,
delay=>1 }), "Testing failed transfer" );
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
