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