view release on metacpan or  search on metacpan

lib/Brackup/Target/Sftp.pm  view on Meta::CPAN

        "SftpHost" => $self->{sftp_host},
        "SftpUser" => $self->{sftp_user},
        "NoColons" => $self->nocolons,
        $self->{sftp_port} ? ("SftpPort" => $self->{sftp_port}) : (),
    };
}

sub _default_nocolons { 
    return 1;        # Can't assume remote OS allows colons
}

sub nocolons {
    my ($self) = @_;
    return defined $self->{nocolons} ? $self->{nocolons} : $self->_default_nocolons;
}

sub _connect {
    my ($self) = @_;

    $self->{sftp} = Net::SFTP::Foreign->new(
        $self->{sftp_host}, 
        user => $self->{sftp_user},
        $self->{sftp_port} ? (port => $self->{sftp_port}) : (),
    );
    $self->{sftp}->error and die $self->{sftp}->error;
}

sub _autoretry {
    my ($self, $code) = @_;
    my $result = $code->();

    if (!defined($result) && !$self->{sftp}->{_connected}) {
        warn "Error in SFTP connection: " . $self->{sftp}->error . "\n";
        sleep $self->{retry_wait};
        warn "Trying to reconnect ...\n";
        $self->_connect();
        $result = $code->();
    }

    return $result;
}

sub _ls {
    my ($self, $path) = @_;
    my $result = $self->_autoretry(sub {
        if (my $ls = $self->{sftp}->ls($path, 
                names_only => 1, no_wanted => qr/^\.\.?$/ )) {
            die "Bad ls results $ls" unless ref $ls && ref $ls eq 'ARRAY';
            return [ map { $path . '/' . $_ } @$ls ];
        }
    });
    unless (defined($result)) {
        die "Listing failed for $path: " . $self->{sftp}->error;
    }
    return wantarray ? @$result : $result;
}

sub size {
    my ($self, $path) = @_;
    my $size = $self->_autoretry(sub {
        my $attr = $self->{sftp}->stat($path)
            or die "Cannot stat path '$path'";
        return $attr->size;
    });
    unless (defined($size)) {
        die "Getting size for $path failed: " . $self->{sftp}->error;
    }
    return $size;
}

sub _mtime {
    my ($self, $path) = @_;
    my $mtime = $self->_autoretry(sub {
        my $attr = $self->{sftp}->stat($path)
            or die "Cannot stat path '$path'";
        return $attr->mtime;
    });
    unless (defined $mtime) {
        die "Getting mtime of $_ failed: " . $self->{sftp}->error;
    }
    return $mtime;
}

sub _mkdir {
    my ($self, $dir) = @_;
    return if ! $dir || $dir eq '/';

    my $parent = dirname($dir);
    $self->_autoretry(sub {
        $self->{sftp}->stat($parent) or $self->_mkdir($parent);
        $self->{sftp}->stat($dir) or $self->{sftp}->mkdir($dir);
    }) or die "Creating directory $dir failed: " . $self->{sftp}->error;
}

sub _put_chunk {
    my ($self, $path, $content) = @_;

    $self->_mkdir(dirname($path));

    $self->_autoretry(sub {
        my $fh = $self->{sftp}->open($path, SSH2_FXF_WRITE|SSH2_FXF_CREAT) 
            or die "Failed to open";
        my $result = $self->{sftp}->write($fh, $content);
        $self->{sftp}->close($fh) or die "Failed to close";
        return $result;
    }) or die "Writing file $path failed: " . $self->{sftp}->error;
}

sub _put_fh {
    my ($self, $path, $fh) = @_;

    $self->_mkdir(dirname($path));

    $self->_autoretry(sub { $self->{sftp}->put($fh, $path) })
        or die "Doing a put to path $path failed: " . $self->{sftp}->error;
}

sub _get {
    my ($self, $path) = @_;
    my $content;

    $self->_autoretry(sub {
        $content = $self->{sftp}->get_content($path);
    }) or die "Reading file $path failed: " . $self->{sftp}->error;

    return \$content;
}

sub _delete {
    my ($self, $path) = @_;
    $self->_autoretry(sub {
        return $self->{sftp}->remove($path);
    }) or die "Removing file $path failed: " . $self->{sftp}->error;
}

sub chunkpath {
    my ($self, $dig) = @_;
    return $self->{path} . '/' . $self->SUPER::chunkpath($dig);
}

sub metapath {
    my ($self, $name) = @_;
    return $self->{path} . '/' . $self->SUPER::metapath($name);
}

sub load_chunk {
    my ($self, $dig) = @_;
    return $self->_get($self->chunkpath($dig));
}

sub store_chunk {