view release on metacpan or  search on metacpan

lib/File/NCopy.pm  view on Meta::CPAN

# does glob work on all systems?
sub expand(@)
{
    my @args;

    return 
        if @_ < 2;

    for (my $i = 0;$i < $#_;++$i) {
        push @args,glob $_[$i];
    }
    push @args,$_[$#_];

    @args;
}

sub new(@); #prototype

# this just redirects calls
sub copy(@)
{
    my $this;

    # were we called through an object reference?
    if(ref $_[0] eq 'File::NCopy') {
        $this = shift;
    }
    else {
        # no, so let's make one
        $this = new File::NCopy;
        if(ref $_[0] eq 'SCALAR') {
            my $rec = shift;
            $this->recursive($$rec);
        }
    }

    my @copies;
    my @args = expand @_;

    print "passed args ==> ".join(',',map {"'$_'"} @args)."\n"
        if $this->{'_debug'};

    # one or more files/directories to a directory
    if(@args >= 2 && -d $args[$#args]) {
        print "Copy to dir started.\n" if ($this->{'_debug'});
        _docopy_files_dir $this, \@copies, @args;
    }
    # file to file
    elsif(@args == 2 && -f $args[0]) {
        if ($this->{test}) {
                push @copies, $args[0];
        } else {
        _docopy_file_file $this, $args[0],$args[1]
            and push @copies, $args[0];
        }
    }

    @copies;
}

sub cp(@) {
    return copy @_;
}

# instantiate our object
sub new(@)
{
    my $this = shift;
    
    my $conf = {
        'test'           => 0,
        'recursive'      => 0,
        'preserve'       => 0,
        'follow_links'   => 0,
        'force_write'    => 0,
        '_debug'         => 0,
        'set_permission' => \&File::NCopy::u_chmod,
        'file_check'     => \&File::NCopy::f_check,
        'set_times'      => \&File::NCopy::s_times,
        '_links'         => {},
    };

    my $ref;
    if(@_ % 2 == 0) {
        my %ref = @_;
        $ref = \%ref;
    }
    elsif(ref $_[0] eq 'HASH') {
        $ref = shift;
    }

    if(ref $ref eq 'HASH') {
        $conf->{'test'} = abs int $ref->{'test'}
            if defined $ref->{'test'};
        $conf->{'recursive'} = abs int $ref->{'recursive'}
            if defined $ref->{'recursive'};
        $conf->{'preserve'} = abs int $ref->{'preserve'}
            if defined $ref->{'preserve'};
        $conf->{'follow_links'} = abs int $ref->{'follow_links'}
            if defined $ref->{'follow_links'};
        $conf->{'force_write'} = abs int $ref->{'force_write'}
            if defined $ref->{'force_write'};
        $conf->{'_debug'} = abs int $ref->{'_debug'}
            if defined $ref->{'_debug'};
        $conf->{'set_permission'} = $ref->{'set_permission'}
            if defined $ref->{'set_permission'}
                && ref $ref->{'set_permission'} eq 'CODE';
        $conf->{'file_check'} = $ref->{'file_check'}
            if defined $ref->{'file_check'}
                && ref $ref->{'file_check'} eq 'CODE';
        $conf->{'set_times'} = $ref->{'set_times'}
            if defined $ref->{'set_times'}
                && ref $ref->{'set_times'} eq 'CODE';
    }

    bless $conf,$this;
}

sub recursive($;$)
{
    return