如何递归复制目录并在Perl中过滤文件名?
题
如何复制包含子目录的目录,不包括与Windows系统上某个正则表达式匹配的文件或目录?
解决方案
我会做这样的事情:
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;
}
其他提示
另一个选项是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");
如果您碰巧在类Unix操作系统上并且可以访问 rsync(1)
,那么您应该使用它(例如通过 system()
)。
Perl的File :: Copy有点不合适(例如,它不会复制Unix系统上的权限),因此如果您不想使用系统工具,请查看CPAN。也许 File :: Copy :: Recursive 可能有用,但是我没有看到任何排除选项。我希望别人有更好的主意。
我不知道如何使用副本进行排除,但您可以按照以下方式进行操作:
ls -R1 | grep -v <regex to exclude> | awk '{printf("cp %s /destination/path",$1)}' | /bin/sh
经典答案将使用' cpio -p
':
(cd $SOURCE_DIR; find . -type f -print) |
perl -ne 'print unless m/<regex-goes-here>/' |
cpio -pd $TARGET_DIR
' cpio
'命令处理实际复制,包括权限保留。 ' cd $ SOURCE_DIR的诀窍;找 。 ...
'处理从名称中删除源路径的前导部分。调用' find
'的唯一问题是它不会遵循符号链接;你需要添加' -follow
',如果你想要的话。
不隶属于 StackOverflow