Perl Net::FTP

Perl Net::FTP

Before the wide spread availability of Perl, I would script ftp transfers with .netrc, ksh scripts and other clumsy ways. None of those methods are fun, flexible or easy. On the other hand, Perl’s Net::FTP module is all of that.

With Net::FTP, you have total control. You know when there are errors, timeouts, whatever. It’s not at all difficult: anyone with basic scripting skills can understand and use this.

I’m going to present two programs here. One is very simple; you can probably understand it even if you know no Perl at all. It just logs into my ftp site, gets a listing, and displays it. The other is a fairly complicated program that goes out to a list of hosts and gets files with a date equal to or newer than what you specify. Even with the extra complexity, you should be able to follow it, and perhaps modify it for your own needs.

Here’s the first:

#!/usr/bin/perl

use Net::FTP;

my $host="aplawrence.com";
my $directory="pub";

$ftp=Net::FTP->new($host,Timeout=>240) or $newerr=1;
push @ERRORS, "Can't ftp to $host: $!\n" if $newerr;
myerr() if $newerr;
print "Connected\n";

$ftp->login("ftp","apl\@") or $newerr=1;
print "Getting file list";
push @ERRORS, "Can't login to $host: $!\n" if $newerr;
$ftp->quit if $newerr;
myerr() if $newerr;
print "Logged in\n";

$ftp->cwd($directory) or $newerr=1;
push @ERRORS, "Can't cd $!\n" if $newerr;
myerr() if $newerr;
$ftp->quit if $newerr;

@files=$ftp->dir or $newerr=1;
push @ERRORS, "Can't get file list $!\n" if $newerr;
myerr() if $newerr;
print "Got file list\n";
foreach(@files) {
print "$_\n";
}
$ftp->quit;


sub myerr {
print "Error: \n";
print @ERRORS;
exit 0;
}

Pretty simple, right? Net::FTP makes it all so easy, so let’s do something that would absolutely drive me batty without it.

#!/usr/bin/perl

use Net::FTP;
$date=shift @ARGV;
@months=qw(null Jan Feb Mar Apr My Jun Jul Aug Sep Oct Nov Dec);
@hosts=qw(pcunix.org pcunix.com xyz.com);
@dirs=qw(pub pub pub);
@logins=qw(ftp anonymous fred);
@passwords=qw(tony\@ apl\@ fxdfed);

$x=0;
foreach(@months) {
$months{$_}=$x++;
}
# we need this hash later

if (not $date) {
$now=time();
$now -= (24 * 3600 );
# yesterday
($nowsec,$nowmin,$nowhr,$nowday,$nowmon,$nowyr,$nowdow,$nowdoy,$nowdst)=localtime($now);
$nowyr+=1900;$nowmon++;
$date=sprintf("%.2d/%.2d/%.4d",$nowmon,$nowday,$nowyr);
print "Using $date\n";
}

$now=time();
($nowsec,$nowmin,$nowhr,$nowday,$nowmon,$nowyr,$nowdow,$nowdoy,$nowdst)=localtime($now);
$nowyr+=1900;

# need $nowyr later

($month,$day,$year)=split /\//,$date;

#
# broken next century - blame me then
#
$year+=2000 if $year < 100;

$x=0;
foreach (@hosts) {
$newerr=0;
$ftp=Net::FTP->new($_,Timeout=>240) or $newerr=1;
push @ERRORS, "Can't ftp to $_: $!\n" if $newerr;
next if $newerr;
print "Connected $_\n";

$ftp->login($logins[$x],$passwords[$x]) or $newerr=1;
push @ERRORS, "Can't login to $_: $!\n" if $newerr;
$ftp->quit if $newerr;
next if $newerr;
print "Logged in $_\n";

$ftp->cwd($dirs[$x]) or $newerr=1;
push @ERRORS, "Can't cd $dirs[$x] on $_ $!\n" if $newerr;
$ftp->quit if $newerr;
next if $newerr;
print "Getting file list $_\n";

@files=$ftp->dir or $newerr=1;
push @ERRORS, "Can't get file list on $_ $!\n" if $newerr;
$ftp->quit if $newerr;
next if $newerr;
print "Got list $_\n";

print "Looking for $date $time\n";
foreach(@files) {
$_=substr($_,41);
s/ */ /g;
s/^ *//g;
chomp;
@stuff=split / /;
# if it's today, the year slot will have time instead
# so make it this year
$stuff[2]=$nowyr if /:/;

$ftp->quit if ($stuff[2] < $year);
next if ($stuff[2] < $year);
$ftp->quit if ($months{$stuff[0]} < $month and $stuff[2] == $year);
next if ($months{$stuff[0]} < $month and $stuff[2] == $year);
$ftp->quit if ($stuff[0] < $day and $stuff[2] == $year and $months{$stuff[0]} == $month);
next if ($stuff[1] < $day and $stuff[2] == $year and $months{$stuff[0]} == $month);

print "Getting $_\n";
$ftp->get($stuff[3],$stuff[3]) or $newerr=1;
push @ERRORS, "Couldn't get $stuff[3] $!\n" if $newerr;

}

$ftp->quit;
}

print @ERRORS;
exit 0;
2010-05-26T11:26:48+00:00 April 27th, 2005|CGI and Perl|0 Comments

About the Author:

Leave A Comment