initial commit

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;