这个是perl网络编程书中例子的源代码
#!/usr/bin/perl -w
# file: ftp_mirror.pl
# Figure 6.2: Recursively mirroring an FTP directory
use strict;
use Net::FTP;
use File::Path;
use Getopt::Long;
use constant USAGEMSG => <<USAGE;
Usage: ftp_mirror.pl [options] host:/path/to/directory
Options:
--user <user> Login name
--pass <pass> Password
--hash Progress reports
--verbose Verbose messages
USAGE
my ($USERNAME,$PASS,$VERBOSE,$HASH);
die USAGEMSG unless GetOptions('user=s' => \$USERNAME,
'pass=s' => \$PASS,
'hash' => \$HASH,
'verbose' => \$VERBOSE);
die USAGEMSG unless my ($HOST,$PATH) = $ARGV[0]=~/(.+):(.+)/;
my $ftp = Net::FTP->new($HOST) or die "Can't connect: $@\n";
$ftp->login($USERNAME,$PASS) or die "Can't login: ",$ftp->message;
$ftp->binary;
$ftp->hash(1) if $HASH;
do_mirror($PATH);
$ftp->quit;
exit 0;
# top-level entry point for mirroring.
sub do_mirror {
my $path = shift;
return unless my $type = find_type($path);
my ($prefix,$leaf) = $path =~ m!^(.*?)([^/]+)/?$!;
$ftp->cwd($prefix) if $prefix;
return get_file($leaf) if $type eq '-'; # ordinary file
return get_dir($leaf) if $type eq 'd'; # directory
warn "Don't know what to do with a file of type $type. Skipping.";
}
# mirror a file
sub get_file {
my ($path,$mode) = @_;
my $rtime = $ftp->mdtm($path);
my $rsize = $ftp->size($path);
$mode = (parse_listing($ftp->dir($path)))[2] unless defined $mode;
my ($lsize,$ltime) = stat($path) ? (stat(_))[7,9] : (0,0);
if ( defined($rtime) and defined($rsize)
and ($ltime >= $rtime)
and ($lsize == $rsize) ) {
warn "Getting file $path: not newer than local copy.\n" if $VERBOSE;
return;
}
warn "Getting file $path\n" if $VERBOSE;
$ftp->get($path) or (warn $ftp->message,"\n" and return);
chmod $mode,$path if $mode;
}
# mirror a directory, recursively
sub get_dir {
my ($path,$mode) = @_;
my $localpath = $path;
-d $localpath or mkpath $localpath or die "mkpath failed: $!";
chdir $localpath or die "can't chdir to $localpath: $!";
chmod $mode,'.' if $mode;
my $cwd = $ftp->pwd or die "can't pwd: ",$ftp->message;
$ftp->cwd($path) or die "can't cwd: ",$ftp->message;
warn "Getting directory $path/\n" if $VERBOSE;
foreach ($ftp->dir) {
next unless my ($type,$name,$mode) = parse_listing($_);
next if $name =~ /^(\.|\.\.)$/; # skip . and ..
get_dir ($name,$mode) if $type eq 'd';
get_file($name,$mode) if $type eq '-';
make_link($name) if $type eq 'l';
}
$ftp->cwd($cwd) or die "can't cwd: ",$ftp->message;
chdir '..';
}
# subroutine to determine whether a path is a directory or a file
sub find_type {
my $path = shift;
my $pwd = $ftp->pwd;
my $type = '-'; # assume plain file
if ($ftp->cwd($path)) {
$ftp->cwd($pwd);
$type = 'd';
}
return $type;
}
# Attempt to mirror a link. Only works on relative targets.
sub make_link {
my $entry = shift;
my ($link,$target) = split /\s+->\s+/,$entry;
return if $target =~ m!^/!;
warn "Symlinking $link -> $target\n" if $VERBOSE;
return symlink $target,$link;
}
# parse directory listings
# -rw-r--r-- 1 root root 312 Aug 1 1994 welcome.msg
sub parse_listing {
my $listing = shift;
return unless my ($type,$mode,$name) =
$listing =~ /^([a-z-])([a-z-]{9}) # -rw-r--r--
\s+\d* # 1
(?:\s+\w+){2} # root root
\s+\d+ # 312
\s+\w+\s+\d+\s+[\d:]+ # Aug 1 1994
\s+(.+) # welcome.msg
$/x;
return ($type,$name,filemode($mode));
}
# turn symbolic modes into octal
sub filemode {
my $symbolic = shift;
my (@modes) = $symbolic =~ /(...)(...)(...)$/g;
my $result;
my $multiplier = 1;
while (my $mode = pop @modes) {
my $m = 0;
$m += 1 if $mode =~ /[xsS]/;
$m += 2 if $mode =~ /w/;
$m += 4 if $mode =~ /r/;
$result += $m * $multiplier if $m > 0;
$multiplier *= 8;
}
$result;
}
