dircopy 和 dirmove 没有按预期工作

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

显然，当运行对数据使用相同的 copy/move 脚本时，我不应该得到不同的响应。不过，奇怪的是，这些文件来自一个目录（我无法弄清楚它们在内容方面都是相同的）并且其他目录被保留了下来。因此在每个运行中，对于一个 $sub_dir，脚本将目录的内容复制到目标而不是目录本身。这意味着我在脚本的每个运行上丢失了一个目录...不过我不明白为什么。

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

经过更多挖掘后，我认为这就是 happens.The 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

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

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 没有按预期工作

dircopy and dirmove not working as expected

filesystems

perl

file-handling