Recursive copy for directory duplicating

[cantfindausername]

I'm very new to perl but have picked up the (very) basics over the last few days. I've been given a task by my work to duplicate a directory structure from one location to another.
The guy thats given me the challenge wants me to use a recursive subroutin.

Ok, so the dir structure I'm using is like this.

All this in C:\test

Folder A/Folder 1
Folder A/Folder 2
Folder A/Folder 2/Folder 3
Folder A/Folder 2/Folder 4

Folder B
Folder B/Folder 5
Folder B/Folder 6
Folder B/Folder 6/Folder 7
Folder B/Folder 6/Folder 8

I need to copy this directory structure (no files) to C:\new

I can get my subroutine to be recursive, but I can't get it to come out of a tree path.

This is my code so far

$startDir = 'c:\test';
$newDir = 'c:\new';

sub myReadDir {
my ($dir) = @_;	

opendir (DIR, $dir);
@dir = readdir (DIR);
closedir(DIR);

  foreach my $file (@dir)  {
    if (!-f $file && $file !~ /\.+/) {
    print $newDir . "\\" . $file . "\n";
   $tempDir = $dir;
   $nextDir = $dir . "\\" . $file;
   $newDir = $newDir . "\\" . $file;

 myReadDir ($nextDir);

} 
}
}

myReadDir($startDir);

I can't get the code to recurse properly to come back out of the path its reached the end of, to start on the next tree down.

I hope someone understands what I mean, and can point me in the direction of where I'm going wrong.

Thanks in advance.
Ant

 

[KevinADC]

with perl you can use forward or back-slashes in the directory paths, which makes writing them easier. Sticking with your methods for the most part, something like this maybe:

use strict;
use warnings;

my $startDir = 'c:\test';
my $newDir = 'c:\new';

myReadDir($startDir);

sub myReadDir {
   my ($dir) = @_;    
   opendir (DIR, $dir);
   my @dir = readdir (DIR);
   closedir(DIR);
   foreach my $file (@dir)  {
      next if ($file eq '.' or $file eq '..');
      if (-d $file) {
         print "$file is a directory\n";
         myReadDir("$dir/$file");
      }
   }			
}

 

[PaulTEG]

Look into File::Find::Copy on

http://search.cpan.org

--Paul

Spend an hour a week on CPAN, helps cure all known programming ailments ;-)

 

[KevinADC]

I don't think there is a File::Find::Copy module Paul. There's this one though:

File::Copy::Recursive

http://search.cpan.org/~dmuey/File-Copy-Recursive-0.16/Recursive.pm

which might fit the bill.

 

[cantfindausername]

Thanks guys. I'll give the code a try, but I've been asked to stay away from the modules for the time being so I can learn it the hard way.

Paul, I don't get a result running that. What gives?

 

[PaulTEG]

apologies

Spend an hour a week on CPAN, helps cure all known programming ailments ;-)

 

[tchatzi]

I think this will help you.

#!/usr/bin/perl

$startDir = q{c:\test};
$newDir = q{c:\new};

&myReadDir($startDir);

exit 0; 

sub myReadDir
{
        my ($dir) = @_;
        my (@dirs,$list);
        opendir(DIR,$dir) || warn "can't open the directory $dir: $!\n";
        @dirs=grep {!(/^\./) && -d "$dir\\$_"} readdir(DIR);        
        closedir (DIR);
        for $list(0..$#dirs)
        {
                mkdir ($newDir) unless -d $newDir;
                $ndir = $dir;
                $ndir =~ s/c:\\test/c:\\new/;
                print $ndir."\\".$dirs[$list],"\n";
                mkdir ($ndir."\\".$dirs[$list]);
                &myReadDir($dir."\\".$dirs[$list]);
        }
        return 1;
}

``The wise man doesn't give the right answers,
he poses the right questions.''
TIMTOWTDI

 

[cantfindausername]

Sorry paul, I meant Kevin. Pengo, I'll give your suggestion a go too.


Thanks all.

 

[KevinADC]

Paul (Kevin), I don't get a result running that. What gives?

I don't know. Is it installed on the server you are using? It's not a core module so may need to be installed.

 

[cantfindausername]

I don't think there are any <i>non standard</i> modules on any of our versions of perl.

I'm going to see if I can get my head round how the one above worked.

Thanks for you help everyone! I've been screwing for days over this.... might have known I'd get the answer within 12hrs on Tek-Tips.

Ant

 

[rharsh]

Not to take away from anyone else's suggestions, but I might use two separate functions to accomplish this. One that follows the source directory structure and one that is called by the first function that actually creates the copies. IMO, it makes the code a bit easier to maintain and allows you to add features.

my ($source, $target) = ('c:\test1', 'c:\copytest1');
follow_dir($source, \&copy_dir);

sub follow_dir {
    my ($path, $code_ref) = @_;
    my ($DH, $file);
    if (-d $path) {
        $code_ref->($path);
        unless (opendir $DH, $path) {
            warn "Couldn't open $path.\n$!\nSkipping!";
            return;
        }
        while ($file = readdir $DH) {
            next if $file eq '.' || $file eq '..';
            follow_dir("$path/$file", $code_ref);
        }
    }
}

sub copy_dir {
    my $copy = $_[0];
    substr($copy, 0, length($source), $target);
    unless (-d $copy) {
        if (mkdir $copy) {
            print "Created $copy\n";
        } else {
            print "Unable to create $copy.\n$!\n";
        }
    } else {
        print "$copy already exists - skipping\n";
    }
}