BatchPayment/Transport/SFTP.pm

   1 package Business::BatchPayment::Transport::SFTP;
   2
   3 =head2 Business::BatchPayment::Transport::SFTP
   4
   5 Import this role to use SFTP.  Requires "host", "port', "user", and
   6 "password" to be set.  The 'sftp' method returns a Net::SFTP::Foreign
   7 object providing 'get' and 'put' methods (among others).  All of these
   8 methods die on error.
   9
  10 Also provides "get_path" and "put_path" attributes.  The default 'download'
  11 and 'upload' methods get and put to those paths on the SFTP host.  You
  12 may find it useful to modify or override that behavior.
  13
  14 =cut
  15
  16 use Net::SFTP::Foreign;
  17 use File::Slurp qw(read_file);
  18 use Moose;
  19 with 'Business::BatchPayment::Transport';
  20
  21 has [ qw( host login password ) ] => (
  22   is => 'rw',
  23   isa => 'Str',
  24 );
  25
  26 has 'port' => (
  27   is => 'rw',
  28   isa => 'Int',
  29   default => 22,
  30 );
  31
  32 has [ 'get_path', 'put_path' ] => (
  33   is => 'rw',
  34   isa => 'Str',
  35 );
  36
  37 has 'sftp' => (
  38   is => 'ro',
  39   isa => 'Net::SFTP::Foreign',
  40   handles => [ 'get', 'put', 'ls', 'setcwd' ],
  41   builder => '_sftp',
  42   lazy => 1,
  43 );
  44
  45 has 'timeout' => (
  46   is => 'rw',
  47   isa => 'Int',
  48   default => 60,
  49 );
  50
  51 sub _sftp {
  52   my $self = shift;
  53   my %args = (
  54     host      => $self->host,
  55     port      => $self->port,
  56     user      => $self->login,
  57     password  => $self->password,
  58     timeout   => $self->timeout,
  59     autodie   => 1,
  60   );
  61   $args{'more'} = '-v' if $self->debug >= 2;
  62   Net::SFTP::Foreign->new(%args);
  63 }
  64
  65 sub upload {
  66   my $self = shift;
  67   die "default SFTP upload requires 'put_path'\n" unless $self->put_path;
  68   my $content = shift;
  69   my ($out, $tmpfile) = tempfile();
  70   die "failed to open temporary file $tmpfile\n" unless $out;
  71   print $out $content;
  72   close $out;
  73   $self->sftp->put($tmpfile, $self->put_path);
  74   unlink $tmpfile;
  75 }
  76
  77 sub download { # mostly illustrative rather than directly useful
  78   my $self = shift;
  79   die "default SFTP download requires 'get_path'\n" unless $self->get_path;
  80   my ($out, $tmpfile) = tempfile();
  81   $self->sftp->get($self->get_path, $out);
  82   close $out;
  83   return read_file($tmpfile);
  84 }
  85
  86 __PACKAGE__->meta->make_immutable;
  87
  88 1;