Perl: How to copy directory without any files?-CodePudding

I would like to copy one folder with subfolders but without the files. With dircopy from package File::Copy::Recursive the whole structure with the files will be copy:

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

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

Is there an appropriate module or do I have use finddepth from module use File::Find; and use rmdir?

CodePudding user response：

I don't know about libraries; some probably exist which can be coerced into giving you that.

Here's one way to do it, indeed using File::Find to find the hierarchy. Then go through that list of full-path locations and make them

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 );

This obtains the listing of directories under the given source directory, without it; that is easily changed. Then those are copied under the target directory, which isn't made.

For making directories, the target directory (under which to make the hierarch) must exist for mkdir to work, since it doesn't create directories recursively; the source's directory hierarchy is built by adding them in order so that is not a problem.

In order to create paths (recursively) see make_path in File::Path

All code shown here has been tested and it works as it stands -- but it needs a lot more testing, and probably debugging.

One other way is by using the Linux tree command.

The tree command can be made into printing directories only, with the full path and without pretty graphics: tree -dfi. With these options the default output

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

turns into

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

This is one convenient form for making those directories.

Here's a (barely-tested) code for finding the directory hierarchy this way:

# 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
}