How can I recursively copy the contents of directory using Perl?

Question

I am running the current version of ActivePerl on Windows Vista, and I was wondering if you could show me the best and simplest way to copy a folder and it's contents to another location. Contents would include various files, and most likely some more nested folders.

I imagine there must be a module out there somewhere that I don't know about that does this - but if there is a simple homebrew type of solution I'd like to see that also.

Answer 1

看看File :: Copy :: Recursive 。

Answer 2

If you are simply copying and not doing any processing on the files, there is no reason not to use xcopy .

Now, I wrote the script below in light of Telemachus's comments to provide you with a starting point. I personally would stick with xcopy for copying and File::Find if file contents need to be processed. Besides, I am sure there are about 37 bugs in the code below. But, if you want to play around, it might be instructive:

#!/usr/bin/perl

use strict;
use warnings;

use File::Spec::Functions qw( catfile );

die "mydeepcp src-dir target-dir\n" unless @ARGV == 2;

my ($src, $target) = @ARGV;
mydeepcp( $src => $target );

sub mydeepcp {
    my ($src, $target) = @_;

    opendir my $dir_h, $src
        or die "Cannot open directory: '$src': $!";

    while ( my $file = readdir $dir_h ) {
        next if $file =~ m{^\.\.?$};
        my $src_path = catfile $src => $file;
        my $target_path = catfile $target => $file;

        if ( -d $src_path ) {
            # FIXME: insert code somewhere to create destination dir 
            mydeepcp($src_path => $target_path);
        }
        elsif ( -f _ ) {
            if ( my $err = docp($src_path => $target_path) ) {
                warn sprintf(
                    "Error copying '%s' from '%s' to '%s': %s\n",
                    $file, $src, $target, $err
                );
            }
        }
        else {
            warn "Skipping '$src_path'\n";
        }
    }

    closedir $dir_h;
    return;
}

sub docp {
    my ($src, $target) = @_;
    warn "'$src' => '$target'\n";
    return;
}

__END__

Output:

C:\Temp> ghj c:\windows f:\qwert
...
'C:\windows\$hf_mig$\KB899591\update\spcustom.dll' => 'F:\qwert\$hf_mig$\KB899591\update\spcustom.dll'
'C:\windows\$hf_mig$\KB899591\update\update.exe' => 'F:\qwert\$hf_mig$\KB899591\update\update.exe'
'C:\windows\$hf_mig$\KB899591\update\update.ver' => 'F:\qwert\$hf_mig$\KB899591\update\update.ver'