Leo*_*ans 11
我会做这样的事情:
use File::Copy;
sub copy_recursively {
my ($from_dir, $to_dir, $regex) = @_;
opendir my($dh), $from_dir or die "Could not open dir '$from_dir': $!";
for my $entry (readdir $dh) {
next if $entry =~ /$regex/;
my $source = "$from_dir/$entry";
my $destination = "$to_dir/$entry";
if (-d $source) {
mkdir $destination or die "mkdir '$destination' failed: $!" if not -e $destination;
copy_recursively($source, $destination, $regex);
} else {
copy($source, $destination) or die "copy failed: $!";
}
}
closedir $dh;
return;
}
Run Code Online (Sandbox Code Playgroud)
另一个选项是File :: Xcopy.顾名思义,它或多或少模仿windows xcopy命令,包括其过滤和递归选项.
从文档:
use File::Xcopy;
my $fx = new File::Xcopy;
$fx->from_dir("/from/dir");
$fx->to_dir("/to/dir");
$fx->fn_pat('(\.pl|\.txt)$'); # files with pl & txt extensions
$fx->param('s',1); # search recursively to sub dirs
$fx->param('verbose',1); # search recursively to sub dirs
$fx->param('log_file','/my/log/file.log');
my ($sr, $rr) = $fx->get_stat;
$fx->xcopy; # or
$fx->execute('copy');
# the same with short name
$fx->xcp("from_dir", "to_dir", "file_name_pattern");
Run Code Online (Sandbox Code Playgroud)
如果您碰巧在类Unix操作系统上并且可以访问rsync (1)
,那么您应该使用它(例如通过system()
).
Perl的File :: Copy有点坏(例如,它不会复制Unix系统上的权限),因此如果您不想使用系统工具,请查看CPAN.也许File :: Copy :: Recursive可能有用,但我没有看到任何排除选项.我希望别人有更好的主意.
归档时间: |
|
查看次数: |
17124 次 |
最近记录: |