view release on metacpan or  search on metacpan

lib/Connector/Builtin/File/SCP.pm  view on Meta::CPAN

    # If we have no path, we tell the caller that we are a connector
    # but if noargs is set, we behave like a scalar...
    my @path = $self->_build_path_with_prefix( shift );
    if (scalar @path == 0 && !$self->noargs()) {
        return { TYPE  => "connector" };
    }

    return {TYPE  => "scalar" };
}


sub exists {

    my $self = shift;

    # No path = connector root which always exists
    my @path = $self->_build_path_with_prefix( shift );
    if (scalar @path == 0) {
        return 1;
    }

    return 1;

}


# return the content of the file
sub set {

    my $self = shift;
    my $file = shift;
    my $data = shift;

    my $content;
    if ($self->content()) {
        $self->log()->debug('Process template for content ' . $self->content());
        my $template = Template->new({});

        $data = { DATA => $data } if (ref $data eq '');

        $template->process( \$self->content(), $data, \$content) || die "Error processing content template.";
    } else {
        if (ref $data ne '') {
            die "You need to define a content template if data is not a scalar";
        }
        $content = $data;
    }


    my $tmpdir = tempdir( CLEANUP => 1 );
    my ($fh, $source) = tempfile( DIR => $tmpdir );

    open FILE, ">$source" || die "Unable to open file for writing";
    print FILE $content;
    close FILE;

    if ($self->filemode()) {
        my $mode = $self->filemode();
        $mode = oct($mode) if $mode =~ /^0/;
        chmod $mode, $source;
    }

    my $target = $self->_sanitize_path( $file, $data );

    my $res = $self->_transfer( $source, $target );
    if ($res) {
        die sprintf("Unable to transfer data (EC %01d)", $res);
    }

    return 1;
}

sub _transfer {

    my $self = shift;
    my $source  = shift;
    my $target = shift;

    my %filehandles;
    my $stdout = File::Temp->new();
    $filehandles{stdout} = \*$stdout;

    my $stderr = File::Temp->new();
    $filehandles{stderr} = \*$stderr;

    # compose the system command to execute
    my @cmd = @{$self->_scp_option()};

    unshift @cmd, $self->command();

    push @cmd, $source;
    push @cmd, $target;

    $self->log()->debug("scp command: " . join(" ",@cmd));

    local $SIG{'CHLD'} = 'DEFAULT';
    my $command = Proc::SafeExec->new({
        exec => \@cmd,
        no_autowait => 1,
        %filehandles,
    });

    eval{
        local $SIG{ALRM} = sub { die "alarm\n" };
        alarm $self->timeout();
        $command->wait();
    };

    alarm 0;

    if ($EVAL_ERROR) {
        $self->log()->debug($EVAL_ERROR);
        $self->log()->error("SCP tranfer timed out");
        return 2;
    }

    if ($command->exit_status() != 0) {
        $self->log()->error("SCP tranfer failed, exit status was " . $command->exit_status());
        return 1;
    }