Perl：如何复制没有文件的目录？

Question

我想复制一个包含子文件夹但没有文件的文件夹。 使用来自dircopy File::Copy::Recursive的 dircopy，将复制包含文件的整个结构：

my $source = 'C:/dir_source';
my $target = 'C:/dir_target';

dircopy $source, $target or die "Could not perform dircopy of $source to $target: $!";

是否有合适的模块，或者我是否使用了模块use File::Find;中的finddepth ？ 并使用 rmdir？

Answer 1

我不知道图书馆； 有些可能存在，可以被迫给你那个。

这是一种方法，实际上是使用File::Find来查找层次结构。 然后 go 通过完整路径位置列表并制作它们

use warnings;
use strict;
use feature 'say';

use File::Find;

sub get_dir_hier {
    my ($src) = @_; 

    my @dirs;
    find( sub { 
        push @dirs, $File::Find::name 
            if -d and $File::Find::name ne $src;  # only UNDER source dir
    }, $src); 

    return \@dirs;
}

sub copy_dir_hier {
    my ($dirs, $tgt, $verbose) = @_; 

    for my $dir (@$dirs) {
        next if not $dir;

        say "mkdir $tgt/$dir" if $verbose;
        # mkdir "$tgt/$dir"                    # UNCOMMENT AFTER TESTING
        #    or warn "Error with mkdir $tgt/$dir: $!";
    }   
}

my ($source_dir, $target_dir) = @ARGV;
die "Usage: $0 source-dir target-dir\n" 
    if not $source_dir or not $target_dir;

say "Copy directory hierarchy from under $source_dir to under $target_dir\n";

say "Find directory hierarchy under $source_dir"; 
my $dirs = get_dir_hier($source_dir);
say for @$dirs; say '-'x60;

say "\nCopy that hierarchy under $target_dir";
copy_dir_hier( $dirs, $target_dir, 1 );

这将获得给定源目录下的目录列表，没有它； 这很容易改变。 然后将这些复制到未创建的目标目录下。

对于创建目录，目标目录（在其下创建层次结构）必须存在才能使mkdir工作，因为它不会递归地创建目录； 源的目录层次结构是通过按顺序添加它们来构建的，因此对于层次结构 rest 来说这不是问题。

为了（递归地）创建路径，请参阅File::Path中的make_path

此处显示的所有代码都已经过测试并且可以按原样工作——但它需要更多的测试，可能还需要调试。

---

另一种方法是使用 Linux tree命令。

tree命令可以只打印目录，带有完整路径，没有漂亮的图形： tree -dfi 。 使用这些选项，默认的 output

$ tree t1
t1
├── f1.txt
├── t21
│   ├── f21a.txt
│   ├── f21.txt
│   └── t31
│       └── f3.txt
└── t22

变成

$ tree -dfi t1
t1
t1/t21
t1/t21/t31
t1/t22

这是制作这些目录的方便形式。

这是一个（几乎没有测试过的）代码，用于以这种方式查找目录层次结构：

# Uses "tree" command
sub get_dir_hier_using_tree {
    my ($src) = @_;

    my @out = qx(tree -dfi $src);

    my @dirs = grep { m{^/|\.} } @out;  #/ keep only directories (full path)
    chomp @dirs;
    #say for @dirs; say '---';

    # Remove the leading part of the path, to the source-directory name
    s{^$src/?}{} for @dirs;

    # Remove possibly empty entries
    @dirs = grep { defined and /\S/ } @dirs;
    #say for @dirs; say '-'x40;

    return \@dirs
}