error callbacks, more structure for parse/format methods
[Business-BatchPayment.git] / 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 strict;
17 use Moose;
18 use Net::SFTP::Foreign;
19 use File::Slurp qw(read_file);
20 with 'Business::BatchPayment::Transport';
21
22 has [ qw( host login password ) ] => (
23   is => 'rw',
24   isa => 'Str',
25 );
26
27 has 'port' => (
28   is => 'rw',
29   isa => 'Int',
30   default => 22,
31 );
32
33 has [ 'get_path', 'put_path' ] => (
34   is => 'rw',
35   isa => 'Str',
36 );
37
38 has 'sftp' => (
39   is => 'ro',
40   isa => 'Net::SFTP::Foreign',
41   handles => [ 'get', 'put', 'ls', 'setcwd' ],
42   builder => '_sftp',
43   lazy => 1,
44 );
45
46 has 'timeout' => (
47   is => 'rw',
48   isa => 'Int',
49   default => 60,
50 );
51
52 sub _sftp {
53   my $self = shift;
54   my %args = (
55     host      => $self->host,
56     port      => $self->port,
57     user      => $self->login,
58     password  => $self->password,
59     timeout   => $self->timeout,
60     autodie   => 1,
61   );
62   $args{'more'} = '-v' if $self->debug >= 2;
63   Net::SFTP::Foreign->new(%args);
64 }
65
66 sub upload {
67   my $self = shift;
68   die "default SFTP upload requires 'put_path'\n" unless $self->put_path;
69   my $content = shift;
70   my ($out, $tmpfile) = tempfile();
71   die "failed to open temporary file $tmpfile\n" unless $out;
72   print $out $content;
73   close $out;
74   $self->sftp->put($tmpfile, $self->put_path);
75   unlink $tmpfile;
76 }
77
78 sub download { # mostly illustrative rather than directly useful
79   my $self = shift;
80   die "default SFTP download requires 'get_path'\n" unless $self->get_path;
81   my ($out, $tmpfile) = tempfile();
82   $self->sftp->get($self->get_path, $out);
83   close $out;
84   return read_file($tmpfile);
85 }
86
87 __PACKAGE__->meta->make_immutable;
88
89 1;