Here is an efficient way to do it. We make each dir exactly once and do it in the file find sub so there is no reprocessing.

sub clone_dir_tree {
    my ( $from, $to ) = @_;
    require File::Find;
    File::Find::find ( 
        sub { return unless -d $File::Find::name;
              $File::Find::name =~ m/^\Q$from\E(.*)$/;
              mkdir "$to/$1";
            }, 
        $from );
}
[download]

cheers

tachyon

s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

If you think of a "directory tree" as a real tree gaph, the minimum number of mkpath() calls you need is exactly the number of leaves in that tree. find() does a depth-first search, so there's a quite efficient way to determine leaves:

my $p = './a';
my @paths = ();

find( sub {
        return unless -d;

        print "$File::Find::name in $File::Find::dir\n";

        unless( $p eq $File::Find::dir ){
                print "CH\n";
                push @paths => $p;
        }

        $p = $File::Find::name;

} , $p );

push @paths , $p;

print "--> $_\n" for @paths;
# this has been tested
[download]

The amount of saved mkpath() calls depends on the directory tree, it's still O(n) where n is the number of directories but that's only reached if the tree is super-flat (depth=1).

But why use mkpath at all? It ends up in n mkdir() calls anyways, why not do that yourself in the find-sub and save the time mkpath() needs to recognize already created directories? mkpath() is not usefull if you do directory traversal anyways. For find() uses depth-first search, it's guaranteed that the parent directory always exists.

find( sub {
   next unless -d;

   mkdir File::Spec->catpath( ... )
} , ' ... '
);
[download]

My first comment is that this does not work properly (or at all on Win32)

The problem is that $File::Find::name is the fullpath so if I try to clone say C:/Perl to C:/New mkpath is passed args like 'C:/New/C:/Perl/site/lib' which is not a valid path. You need to make the paths relative to $from. This will actually work and produce a clone where the new root $to contains exactly what $from does:

#!/usr/bin/perl -w
use strict;
use File::Find;
use File::Path 'mkpath';

#usage dirtreeclone fromdir todir   No trailing slashes 

my $from = shift || '.';
my $to =   shift || "$0-tmp";
my @dirs;

find (sub {push @dirs => $File::Find::name if -d},$from);

foreach my $dir(@dirs){
    $dir =~ s/^\Q$from\E//;
    mkpath("$to/$dir");
}
[download]

cheers

tachyon

s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

-- Randal L. Schwartz, Perl hacker
Be sure to read my standard disclaimer if this is a reply.

There is a subtle detail here that makes a difference: Are you just cloning the directories, or are you also copying all the files in those directories? For copying directories and files there are a few existing CPAN modules:

• File::NCopy
• File::DirSync
• File::Rsync

I'm not familiar enough with rsync to know whether or not it supports copying just directories and not the files in them (I've always used it to copy both). Maybe Randal can answer that since he's put a lot of work into his smart version.

mkpath() takes a list of directories, so this:

foreach my $dir(@dirs){
mkpath("$to/$dir");
}
[download]

Can be changed to:

mkpath(@dirs);
[download]

But that will only work if $to is prepended to each file name in @dirs. Change your find() to this:

find (sub {push @dirs => $to . '/' . $File::Find::name if -d},$from);
[download]

Unless there's something I'm missing.

This example clones a directory tree:

use File::Flat;
use File::List;

my $search = new File::List("/usr/local/man");
$search->show_only_dirs();
my @dirs  = @{ $search->find(".*") };
foreach my $dirname (@dirs){
  File::Flat->makeDirectory("/copy".$dirname);
}
[download]

It should work perfectly the first time! - toma