view release on metacpan or  search on metacpan

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

package Dackup::Target::SSH;
use Moose;
use MooseX::StrictConstructor;
use MooseX::Types::Path::Class;
use Data::Dumper;
use Digest::MD5::File qw(file_md5_hex);
use File::Copy;
use Path::Class;

extends 'Dackup::Target';

has 'ssh' => (
    is       => 'ro',
    isa      => 'Net::OpenSSH',
    required => 1,
);

has 'prefix' => (
    is       => 'ro',
    isa      => 'Path::Class::Dir',
    required => 1,
    coerce   => 1,
);

has 'directories' => (
    is       => 'rw',
    isa      => 'HashRef',
    required => 0,
    default  => sub { {} },
);

__PACKAGE__->meta->make_immutable;

sub entries {
    my $self        = shift;
    my $ssh         = $self->ssh;
    my $dackup      = $self->dackup;
    my $prefix      = $self->prefix;
    my $cache       = $dackup->cache;
    my $directories = $self->directories;

    my ( $type, $type_err )
        = $ssh->capture2(qq{perl -e 'print "directory\\n" if -d "$prefix"'});
    chomp $type;
    return [] if $type ne 'directory';

    my $code = <<'EOF';
#!perl
use strict;
use warnings;
use File::Find;

my $root = 'XXX';
find( \&wanted, $root );

sub wanted {
    my $filename = $File::Find::name;
    my ($dev,  $ino,   $mode,  $nlink, $uid,     $gid, $rdev,
        $size, $atime, $mtime, $ctime, $blksize, $blocks
    ) = stat($filename);
    my $type;
    if ( -f _ ) {
        $type = 'file';
    } elsif ( -d _ ) {
        $type = 'directory';
    } else {
        $type = 'other';
    }
    print "$type:$ctime:$mtime:$size:$ino:$filename\n";
}
EOF
    $code =~ s/XXX/$prefix/;

    my ($tmpnam)
        = $ssh->capture(
        q{perl -e 'use File::Temp qw/:POSIX/; print scalar tmpnam() . "\n"'})
        || die "ssh failed: " . $ssh->error;
    chomp $tmpnam;

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

    my ($output) = $ssh->capture2("perl $tmpnam")
        || die "ssh failed: " . $ssh->error;
    $ssh->system("rm $tmpnam")
        or die "remote command failed: " . $ssh->error;
    return [] unless $output;

    my @entries;
    my @not_in_cache;
    foreach my $line ( split "\n", $output ) {
        my ( $type, $ctime, $mtime, $size, $inodenum, $filename ) = split ':',
            $line, 6;
        next if $type eq 'other';
        confess "Error with stat: $line"
            unless $type
                && defined($filename)
                && $ctime
                && $mtime
                && defined($size)
                && defined($inodenum);

        if ( $type eq 'directory' ) {
            $directories->{$filename} = 1;
            next;
        }

        my $key = file($filename)->relative($prefix)->stringify;
        my $cachekey
            = 'ssh:' . $ssh->{_user} . ':' . $ssh->{_host} . ':' . $line;

        my $md5_hex = $cache->get($cachekey);
        if ($md5_hex) {
            push @entries,
                Dackup::Entry->new(