|
|
发表于 2003-11-19 13:50:28
|
显示全部楼层
This script come from internet:
一个简单的FTP镜像脚本，它递归地将一个本地目录和远程目录做比较，，并将新地或更新过的文件拷贝到本地机器，保持目录的结构，脚本在本地拷贝中保持文件的模式，也尽力保持符号链接。
为了从远程服务器镜像文件和目录，以命令行参数调用这个脚本，命令行参数的组成为远程服务器的DNS名字，一个冒号，以及要镜像的文件或目录的路径。下面的例子镜像文件RECENT,只在从最后一次镜像该文件之后且文件又被改变的情况下才将它拷贝到本地目录：
$ftp_mirror.pl ftp.perl.org:/pub/CPAN/RECENT
下一个例子镜像CPAN模块目录的全部内容，递归地将远程目录结构拷贝到当前本地工作目录中(不要逐字地用这条命令，除非你地网络连接非常快速并且你具又很多地FREE磁盘空间)；
$ftp_mirror.pl ftp.perl.org:/pub/CPAN
这个脚本地命令行选项包括--user和--pass,为非匿名FTP提供用户和密码；还包括--verbose,获取详细地状态报告；以及--hash,在文件传输过程中打印出散列标记。
----------------start
#!/usr/bin/perl -w
# file: ftp_mirror.pl
# Figure 6.2: Recursively mirroring an FTP directory
use strict;
use Net::FTP;
use File: ath;
use Getopt: ong;
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;
} |
|
IP卡
狗仔卡
显身卡