summaryrefslogtreecommitdiff
path: root/BatchPayment/Transport/SFTP.pm
diff options
context:
space:
mode:
Diffstat (limited to 'BatchPayment/Transport/SFTP.pm')
-rw-r--r--BatchPayment/Transport/SFTP.pm88
1 files changed, 88 insertions, 0 deletions
diff --git a/BatchPayment/Transport/SFTP.pm b/BatchPayment/Transport/SFTP.pm
new file mode 100644
index 0000000..08d2fb7
--- /dev/null
+++ b/BatchPayment/Transport/SFTP.pm
@@ -0,0 +1,88 @@
+package Business::BatchPayment::Transport::SFTP;
+
+=head2 Business::BatchPayment::Transport::SFTP
+
+Import this role to use SFTP. Requires "host", "port', "user", and
+"password" to be set. The 'sftp' method returns a Net::SFTP::Foreign
+object providing 'get' and 'put' methods (among others). All of these
+methods die on error.
+
+Also provides "get_path" and "put_path" attributes. The default 'download'
+and 'upload' methods get and put to those paths on the SFTP host. You
+may find it useful to modify or override that behavior.
+
+=cut
+
+use Net::SFTP::Foreign;
+use File::Slurp qw(read_file);
+use Moose;
+with 'Business::BatchPayment::Transport';
+
+has [ qw( host login password ) ] => (
+ is => 'rw',
+ isa => 'Str',
+);
+
+has 'port' => (
+ is => 'rw',
+ isa => 'Int',
+ default => 22,
+);
+
+has [ 'get_path', 'put_path' ] => (
+ is => 'rw',
+ isa => 'Str',
+);
+
+has 'sftp' => (
+ is => 'ro',
+ isa => 'Net::SFTP::Foreign',
+ handles => [ 'get', 'put', 'ls', 'setcwd' ],
+ builder => '_sftp',
+ lazy => 1,
+);
+
+has 'timeout' => (
+ is => 'rw',
+ isa => 'Int',
+ default => 60,
+);
+
+sub _sftp {
+ my $self = shift;
+ my %args = (
+ host => $self->host,
+ port => $self->port,
+ user => $self->login,
+ password => $self->password,
+ timeout => $self->timeout,
+ autodie => 1,
+ );
+ $args{'more'} = '-v' if $self->debug >= 2;
+ Net::SFTP::Foreign->new(%args);
+}
+
+sub upload {
+ my $self = shift;
+ die "default SFTP upload requires 'put_path'\n" unless $self->put_path;
+ my $content = shift;
+ my ($out, $tmpfile) = tempfile();
+ die "failed to open temporary file $tmpfile\n" unless $out;
+ print $out $content;
+ close $out;
+ $self->sftp->put($tmpfile, $self->put_path);
+ unlink $tmpfile;
+}
+
+sub download { # mostly illustrative rather than directly useful
+ my $self = shift;
+ die "default SFTP download requires 'get_path'\n" unless $self->get_path;
+ my ($out, $tmpfile) = tempfile();
+ $self->sftp->get($self->get_path, $out);
+ close $out;
+ return read_file($tmpfile);
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;