Changes
TD_EFT.pm
+TD_EFT/Transport.pm
Makefile.PL
MANIFEST This list of files
README
return_branch => '10202', # 0004 + 5-digit branch number
return_account => '00124598951', # 11 digits
cpa_code => '120',
+ # optional, for SFTP file transport
+ host => '192.168.100.1',
+ login => 'mylogin',
+ password => 'mypassword',
+ # optional, for encryption
+ encrypt_cmd => 'compx ASCII DE3',
+ decrypt_cmd => 'decompx',
+ encrypt_key => '/path/to/encrypt.key',
);
my $result = $processor->submit(@items);
=back
+=head2 TRANSPORT ATTRIBUTES
+
+These need to be specified only if you're using the SFTP transport.
+
+=over 4
+
+=item host - SFTP hostname
+
+=item login - SFTP username
+
+=item password - SFTP password
+
+=item encrypt_cmd - Command to use to encrypt/compress batches before
+sending. This will be called, somewhat awkwardly, with the name of the
+output file inserted as the first argument, and the name of the input
+file (the plaintext) passed on standard input. If empty, batches will
+be sent as plaintext.
+
+=item descrypt_cmd - Command to decrypt/decompress downloaded batches.
+
+=item encrypt_key - File to copy into the working directory before
+running encrypt/decrypt commands. COMPX requires the encryption key
+to be supplied like this.
+
+=back
+
=cut
use DateTime;
required => 1,
);
+has [ qw( login password host encrypt_cmd encrypt_key decrypt_cmd ) ] =>
+(
+ is => 'rw',
+ isa => 'Str',
+ required => 0,
+); # only required for the default transport
+
sub BUILD {
my $self = shift;
# should be a parametric string type or something
unless length($self->return_branch) == 9;
}
+sub default_transport {
+ my $self = shift;
+ Business::BatchPayment->create('TD_EFT::Transport' =>
+ login => $self->login,
+ password => $self->password,
+ host => $self->host,
+ put_path => 'APXBA807/',
+ debug => $self->debug,
+ encrypt_cmd => $self->encrypt_cmd,
+ decrypt_cmd => $self->decrypt_cmd,
+ encrypt_key => $self->encrypt_key,
+ );
+}
+
+
before format_request => sub {
my ($self, $batch) = @_;
#shazam!
use List::Util qw(sum);
has [qw( create_date fcn )] => ( is => 'rw', isa => 'Str' );
+# XXX use the "totals" method instead
has [qw( row total_payment total_credit count_payment count_credit )] =>
( is => 'rw', isa => 'Int', default => 0 );
-=back
-
=head1 AUTHOR
Mark Wells, C<< <mark at freeside.biz> >>
--- /dev/null
+package Business::BatchPayment::TD_EFT::Transport;
+
+use File::Temp qw(tempdir);
+use File::Slurp qw( read_file write_file );
+use File::Copy;
+use IPC::Run qw(run);
+use Moose;
+extends 'Business::BatchPayment::Transport::SFTP';
+
+=head1 ATTRIBUTES
+
+=over 4
+
+=item encrypt_cmd
+
+Path to the encrypt command, including any options. The name of the
+file to encrypt will be passed on standard input, and the name of the
+destination file will be inserted after the first (whitespace-separated)
+word of the command. This is in deference to compx/Comm-Press/TDClient
+conventions.
+
+=item decrypt_cmd
+
+Path to the decrypt command, as above.
+
+=item encrypt_key
+
+Path to the encryption key. This will be copied to the temp directory
+before running encrypt/decrypt commands.
+
+=cut
+
+has [ qw( encrypt_cmd encrypt_key decrypt_cmd ) ] => (
+ is => 'rw',
+ isa => 'Maybe[Str]',
+ required => 0,
+);
+
+sub upload {
+ my $self = shift;
+ my $path = $self->put_path;
+
+ my $content = shift;
+
+ # get the batch ID of the content
+ # (questionable--on the one hand, upload isn't supposed to concern
+ # itself with the contents of the batch, but on the other hand it
+ # needs to know what to name the file.)
+ my $id = substr($content, 20, 4);
+
+ my $tmpdir = tempdir( CLEANUP => 1 );
+ chdir($tmpdir);
+ my $filename = 'update' . $id;
+ warn "Writing temp file to $tmpdir/$filename\n" if $self->debug;
+ write_file("$tmpdir/$filename", $content);
+ if ( $self->encrypt_cmd ) {
+ warn "Encrypting temp file.\n" if $self->debug;
+ if ( $self->encrypt_key ) {
+ copy($self->encrypt_key, "$tmpdir/encrypt.key")
+ or die "Failed to read encryption key: $!\n";
+ }
+ my @cmd = split(/\s+/, $self->encrypt_cmd);
+ # insert output file name into command line
+ splice(@cmd, 1, 0, "$filename.cmp");
+ # run(COMMMAND, STDIN, STDOUT)
+ run(\@cmd, \$filename) or die "Failed to encrypt temp file: $!\n";
+ $filename = "$filename.cmp";
+ }
+ warn "Uploading file to $path/$filename\n" if $self->debug;
+ $self->sftp->setcwd($path);
+ $self->sftp->put("$tmpdir/$filename", $filename);
+ chdir('/');
+}
+
+sub download {
+ my $self = shift;
+ my $path = $self->get_path;
+
+ my @batches;
+ my $tmpdir = tempdir( CLEANUP => 1 );
+ chdir($tmpdir);
+ warn "Fetching list of return files from $path\n" if $self->debug;
+ $self->sftp->setcwd($path);
+ my $files = $self->sftp->ls('.', wanted => qr/^APXQA807/, names_only => 1);
+ if ( !@$files ) {
+ warn "No files found.\n" if $self->debug;
+ }
+ if ( $self->encrypt_key ) {
+ copy($self->encrypt_key, "$tmpdir/encrypt.key")
+ or die "Failed to read encryption key: $!\n";
+ }
+ FILE: foreach my $filename (@$files) {
+ warn "Retrieving file $filename\n" if $self->debug;
+ $self->sftp->get($filename, "$tmpdir/$filename");
+ if ( $self->sftp->error ) {
+ warn "failed to download $filename: ".$self->sftp->error;
+ next FILE;
+ }
+ $filename = "$tmpdir/$filename";
+ if ( $self->decrypt_cmd ) {
+ my @cmd = split(/\s+/, $self->decrypt_cmd);
+ splice(@cmd, 1, 0, "$filename.txt");
+ if ( !run(\@cmd, \$filename) ) {
+ warn "Failed to decrypt file: $!\n";
+ next FILE;
+ }
+ }
+ push @batches, read_file($filename);
+ }
+ chdir('/');
+ @batches;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+++ /dev/null
-#!perl -T
-
-use 5.006;
-use strict;
-use warnings;
-use Test::More tests => 3;
-
-sub not_in_file_ok {
- my ($filename, %regex) = @_;
- open( my $fh, '<', $filename )
- or die "couldn't open $filename for reading: $!";
-
- my %violated;
-
- while (my $line = <$fh>) {
- while (my ($desc, $regex) = each %regex) {
- if ($line =~ $regex) {
- push @{$violated{$desc}||=[]}, $.;
- }
- }
- }
-
- if (%violated) {
- fail("$filename contains boilerplate text");
- diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
- } else {
- pass("$filename contains no boilerplate text");
- }
-}
-
-sub module_boilerplate_ok {
- my ($module) = @_;
- not_in_file_ok($module =>
- 'the great new $MODULENAME' => qr/ - The great new /,
- 'boilerplate description' => qr/Quick summary of what the module/,
- 'stub function definition' => qr/function[12]/,
- );
-}
-
-TODO: {
- local $TODO = "Need to replace the boilerplate text";
-
- not_in_file_ok(README =>
- "The README is used..." => qr/The README is used/,
- "'version information here'" => qr/to provide version information/,
- );
-
- not_in_file_ok(Changes =>
- "placeholder date/time" => qr(Date/time)
- );
-
- module_boilerplate_ok('lib/Business/BatchPayment/TD_EFT.pm');
-
-
-}
-