Question

我正在编写一个Perl脚本，它允许我们轻松地将一个巨大的目录（可能是+100,000个子目录）移动或复制到另一个位置。我正在将File::Copy::Recursive用于此目的，如下所示（不完整！某些变量未定义，但它对发生的事情的概念很少）：

use strict;
use warnings;

use File::Copy::Recursive qw(dircopy dirmove pathrmdir);
$File::Copy::Recursive::CPRFComp = 1;


my ($action, $source_location, $target_location) = @ARGV;
opendir(my $source_handle, $source_location) or die "Can't opendir $source_location: $!\n";
my $directories_found = 0;

while (my $sub_dir = readdir $source_handle) {
    unless (-d "$source_location/$sub_dir") {
        print STDERR "$source_location/$sub_dir not a dir\n";
        next;
    }
    # Makes sure we only move directories given a pattern defined elsewhere
    if ($sub_dir =~ $file_match_regex) {
        # $action is an input argument
        if ($action eq 'copy') {
            dircopy("$source_location/$sub_dir/", "$target_location/")
                or die "Cannot copy $source_location/$sub_dir/: $!\n";
        } elsif ($action eq 'move') {
            dirmove("$source_location/$sub_dir/", "$target_location/")
                or die "Cannot move $source_location/$sub_dir/: $!\n";
        }
        $directories_found = 1;
    } else {
        print STDERR "$source_location/$sub_dir did not match regex\n";
    }
}

if ($action eq 'move') {
    # Remove topmost directory
    pathrmdir($source_location)
        or die "Cannot remove $source_location: $!\n";
}

if (!$directories_found) {
    print STDERR "No items found to $action\n";
}

首次运行此似乎按预期工作。拿这个命令

perl myscript.pl move source/ /home/otherdir/target/

终端输出

source/. did not match regex
source/.. did not match regex

就是这样。

但是，当我在移动的文件夹上运行相同的脚本时，出现问题。

perl myscript.pl move /home/otherdir/target/ /home/failing/target/

/home/otherdir/target/. did not match regex
/home/otherdir/target/.. did not match regex
/home/otherdir/target/somefile1.txt not a dir
/home/otherdir/target/somefile2.txt not a dir
/home/otherdir/target/somefile3.txt a dir
/home/otherdir/target/somefile4.txt a dir

显然，在数据上运行相同的复制/移动脚本时，我不应该得到不同的响应。但是，特殊的是，文件来自一个目录（我无法弄清楚它们在内容方面是完全相同的）以及其他目录是否被保留。因此，在每次运行中，对于一个$ sub_dir，脚本将目录的内容复制到目标而不是目录本身。这意味着我在每次运行脚本时都会丢失一个目录......但我不明白为什么。

我认为我误导了dircopy和dirmove，而且我不确定$File::Copy::Recursive::CPRFComp = 1;是否正确（我没有发现文件对我来说非常清楚）新手眼睛）。有什么想法吗？

经过多次挖掘后，我认为这就是发生的事情。有关CPRFComp读取的小文档（假设'foo / file'）：

dircopy('foo', 'bar') or die $!;
# if bar does not exist the result is bar/file
# if bar does exist the result is bar/file

$File::Copy::Recursive::CPRFComp = 1;
dircopy('foo', 'bar') or die $!;
# if bar does not exist the result is bar/file
# if bar does exist the result is bar/foo/file

因此，我的猜测是，在目标位置（示例中的“bar”）存在之前触发了子目录的第一个复制/移动操作，这导致了bar / file而不是bar / foo / file。然后问题变为：如何确保我的复制/移动操作等到目标目录构建？

Answer 1

为了确保在将任何子目录移动或复制到它之前存在路径，我只是在使用File :: Path模块的make_path进行操作之前创建路径。简单地说，就像这样：

if ($action eq 'copy') {
  make_path($target_location);
  dircopy("$source_location/$sub_dir/", "$target_location/")
        or die "Cannot copy $source_location/$sub_dir/: $!\n";
} elsif ($action eq 'move') {
  make_path($target_location);
  dirmove("$source_location/$sub_dir/", "$target_location/")
        or die "Cannot move $source_location/$sub_dir/: $!\n";
}

dircopy和dirmove没有按预期工作

1 个答案: