view release on metacpan or  search on metacpan

lib/Dackup/Target/SSH.pm  view on Meta::CPAN

            [ [ map { $_->{filename} } @not_in_cache ] ],
            ['filenames'] );
        $code =~ s/XXX/$files/;

        my ( $rin, $in_pid ) = $ssh->pipe_in("cat > $tmpnam")
            or die "pipe_in method failed: " . $ssh->error;
        $rin->print($code) || die $!;
        $rin->close || die $ssh->error;
        waitpid( $in_pid, 0 );

        my %filename_to_d;
        foreach my $d (@not_in_cache) {
            my $filename = $d->{filename};
            $filename_to_d{$filename} = $d;
        }

        my ($lines) = $ssh->capture2("perl $tmpnam")
            || die "ssh failed: " . $ssh->error;

        foreach my $line ( split "\n", $lines ) {

            # chomp $line;
            #warn "[$line]";
            my ( $md5_hex, $filename ) = split / +/, $line, 2;

            #warn "[$md5_hex, $filename]";
            confess "Error with $line"
                unless defined $md5_hex && defined $filename;
            my $d = $filename_to_d{$filename};
            confess "Missing d for $filename" unless $d;
            push @entries,
                Dackup::Entry->new(
                {   key     => $d->{key},
                    md5_hex => $md5_hex,
                    size    => $d->{size},
                }
                );
            $cache->set( $d->{cachekey}, $md5_hex );
        }
        $ssh->system("rm $tmpnam")
            or die "remote command failed: " . $ssh->error;
    }
    return \@entries;
}

sub filename {
    my ( $self, $entry ) = @_;
    return file( $self->prefix, $entry->key );
}

sub name {
    my ( $self, $entry ) = @_;
    my $ssh = $self->ssh;
    return
          'ssh://'
        . $ssh->{_user} . '@'
        . $ssh->{_host}
        . file( $self->prefix, $entry->key );
}

sub update {
    my ( $self, $source, $entry ) = @_;
    my $ssh                   = $self->ssh;
    my $source_type           = ref($source);
    my $destination_filename  = $self->filename($entry);
    my $destination_directory = $destination_filename->parent;
    my $directories           = $self->directories;

    if ( $source_type eq 'Dackup::Target::Filesystem' ) {
        my $source_filename = $source->filename($entry);

        unless ( $directories->{$destination_directory} ) {

            my $quoted_destination_directory
                = $ssh->shell_quote("$destination_directory");

            # warn "mkdir -p $quoted_destination_directory";
            $ssh->system("mkdir -p $quoted_destination_directory")
                || die "mkdir -p $quoted_destination_directory failed: "
                . $ssh->error;
            $directories->{$destination_directory} = 1;
        }

        #warn "$source_filename -> $destination_filename";

        my $scp_options = {};
        my $throttle    = $self->dackup->throttle;
        if ($throttle) {
            my $data_rate       = Number::DataRate->new;
            my $bits_per_second = $data_rate->to_bits_per_second($throttle);
            $scp_options->{bwlimit} = $bits_per_second / 1000;    # in Kbit/s
        }

        $ssh->scp_put( $scp_options, "$source_filename",
            "$destination_filename" )
            || die "scp failed: " . $ssh->error;
    } else {
        confess "Do not know how to update from $source_type";
    }
}

sub delete {
    my ( $self, $entry ) = @_;
    my $ssh      = $self->ssh;
    my $filename = $self->filename($entry);

    $ssh->system("rm -f $filename")
        || die "rm -f $filename failed: " . $ssh->error;
}

1;

__END__

=head1 NAME

Dackup::Target::SSH - Flexible file backup remote hosts via SSH

=head1 SYNOPSIS

  use Dackup;