Copy Directory Structure using Perl utility

Do you have a directory and want to create a replica of the directory structure but without it's file contents? Then this is the utility that let you do it.



#!/usr/bin/perl -w
use strict;

use File::Find;
use File::Path;

my %files;

#CORRECT USAGE
#my $ROOT_DIR="F:/NOT TO BE BACKED UP";
#my $RELATIVE_PATH_UNDER_ROOT_DIR="INSTALL";      #That is I want the directory structure of $ROOT_DIR/$RELATIVE_PATH_UNDER_ROOT_DIR created new at $NEW_ROOT/$RELATIVE_PATH_UNDER_ROOT_DIR
#my $NEW_ROOT="F:/Anurag";

my $ROOT_DIR="F:/STATIC/Anurag";
my $RELATIVE_PATH_UNDER_ROOT_DIR="personal";      #That is I want the directory structure of $ROOT_DIR/$RELATIVE_PATH_UNDER_ROOT_DIR created new at $NEW_ROOT/$RELATIVE_PATH_UNDER_ROOT_DIR
my $NEW_ROOT="F:/Anurag";


sub mySub
{

        my $dir=$File::Find::dir;
       
        $dir=~s{^$ROOT_DIR}{$NEW_ROOT};
       
$files{$dir}++};

sub loadFiles {


       
find( \&mySub, "$ROOT_DIR/$RELATIVE_PATH_UNDER_ROOT_DIR");    #custom subroutine find, parse $dir

}





die "$NEW_ROOT is not directory"  if( ! -d  $NEW_ROOT);

die "$ROOT_DIR/$RELATIVE_PATH_UNDER_ROOT_DIR is not directory" if ( ! -d "$ROOT_DIR/$RELATIVE_PATH_UNDER_ROOT_DIR" );

loadFiles();

my $dirs = keys %files;
my $created=0;


foreach my $key (keys %files)
{
if( ! -d $key)
{
   
    if( scalar( mkpath($key)) <= 0)   #Add error checking here
    {
        print STDERR "Failed to create directory: $key!\n";
    }
    else
    {
        ++$created;
    }
}

   
}

#map { print "$_\n"; } sort keys %files;



print "Total dirs created=$created out of $dirs","\n";