File Coverage

blib/lib/File/Mirror.pm

Criterion	Covered	Total	%
statement	18	30	60.0
branch	0	6	0.0
condition	0	3	0.0
subroutine	6	10	60.0
pod	0	2	0.0
total	24	51	47.0

package File::Mirror;
use base qw(Exporter);
use strict;
use warnings;
use File::Copy;
use File::Find;
use File::Spec;

our @EXPORT = qw(
                    mirror
                    recursive
               );

our $VERSION = '0.10';

sub recursive(&@) {
    my ($code, $src, $dst) = @_;
    my @src = File::Spec->splitdir($src);
    pop @src unless defined $src[$#src] and $src[$#src] ne '';
    my $src_level = @src;
    find({ wanted => sub {
               my @src = File::Spec->splitdir($File::Find::name);
               my $from = File::Spec->catfile($src, @src[$src_level .. $#src]);
               my $to = File::Spec->catfile($dst, @src[$src_level .. $#src]);
               $code->($from, $to);
           },
           no_chdir => 1,
         },
         $src,
        );
}

sub mirror {
    recursive { -d $_[0] ? do { mkdir($_[1]) unless -d $_[1] } : copy(@_) } @_;
}

1;
__END__