dircopy和dirmove不能按预期工作

Question

我正在写一个Perl脚本，它允许我们轻松地将HUGE目录（可能+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;是否正确（我没有发现文档对于我的新手眼睛来说非常清楚）。有什么想法吗？

---

后一些更多的挖我认为这是什么happens.The文档很少有关于CPRFComp读取（假设“富/文件”）：

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"; 
}