# things that get encoded in the batch:
$batch->gateway($self->gateway);
$batch->gateway_opts($self->gateway_opts);
- $self->serialize($batch); # that's all folks
+ $batch;
}
sub parse_response {
my $self = shift;
my $input = shift;
- my $batch = $self->deserialize($input);
}
package Business::BatchPayment::CardFortress::Batch;
with 'Business::BatchPayment::TestMode';
use File::Slurp;
+use Data::Dumper;
+use Try::Tiny;
use MIME::Base64;
use Crypt::OpenSSL::RSA;
+local $Data::Dumper::Useqq = 1; # because encryption keys will be unprintable
+
has '+host' => (
default => sub {
my $self = shift;
- $self->test_mode ? 'gw.cardfortress.com'
- : 'test.cardfortress.com'
+ $self->test_mode ? 'test.cardfortress.com'
+ : 'gw.cardfortress.com'
},
lazy => 1,
);
has 'serializer' => ( handles => [qw(serialize deserialize)] );
+sub https_post {
+ # simplify this a little
+ my ($self, $path, $args) = @_;
+ warn "Sending to $path\n" if $self->debug;
+ $args ||= {};
+ warn Dumper($args)."\n\n" if $self->debug >= 2;
+ $args = {
+ content => $self->serialize($args),
+ login => $self->login,
+ password => $self->password
+ };
+ my ($page, $response, %reply_headers) = Net::HTTPS::Any::https_post(
+ host => $self->host,
+ port => $self->port,
+ path => $path,
+ args => $args,
+ debug => 0,
+ );
+ die "Bad response from server: $response\n" if $response !~ /^200/;
+ warn "$response\n" if $self->debug;
+ my ($result, $error);
+ try {
+ $result = $self->deserialize($page);
+ } catch {
+ # Storable error messages are useless.
+ $error = "Bad data from server:\n$page\n";
+ };
+ warn Dumper($result)."\n\n" if $self->debug >= 2;
+ $error ||= $result->{error} if ref $result eq 'HASH';
+ die "$error\n" if $error;
+
+ $result;
+};
+
sub upload {
my ($self, $content) = @_;
warn "Sending batch...\n" if $self->debug;
- my ($page, $response, %reply_headers) =
- $self->https_post('/batch/submit', {
- login => $self->login,
- password => $self->password,
- content => $content,
- });
- $page = $self->deserialize($page);
- die $page->{error} if $page->{error};
- my $batchid = $page->{batchid};
+ my $result = $self->https_post('/batch/submit', $content);
+ die $result->{error} if $result->{error};
+ my $batch_id = $result->{batch_id};
my $private_key = read_file($self->private_key)
or die "No private key available";
my $rsa = Crypt::OpenSSL::RSA->new_private_key($private_key);
my %answers;
- foreach my $item (@{ $page->{items} }) {
+ foreach my $item (@{ $result->{items} }) {
if ( $item->{error} ) {
# We have no reliable way to report an error in a specific transaction
# at this stage. The server will send the error in the reply batch.
# For now do nothing.
} elsif ( $item->{challenge} ) {
my $challenge = $item->{challenge};
- $answers{ $item->{tid} } = $rsa->decrypt( decode_base64($challenge) );
- } else {
- # newly created card--doesn't have a challenge, so do nothing
+ $answers{ $item->{tid} } = $rsa->decrypt($challenge);
}
}
# post the response
warn "Answering cryptographic challenge...\n" if $self->debug;
- my $answer_content =
- $self->serialize({ batchid => $batchid, answers => \%answers });
- ($page, $response, %reply_headers) =
- $self->https_post('/batch/run', {
- login => $self->login,
- password => $self->password,
- content => $answer_content,
- });
- $page = $self->deserialize($page);
- die $page->{error} if $page->{error};
- return;
+ $self->https_post('/batch/run', { batch_id => $batch_id, answers => \%answers});
+}
+
+sub download {
+ my $self = shift;
+ warn "Fetching batch index...\n" if $self->debug;
+ my $result = $self->https_post('/batch/status');
+
+ my @batches_in_transit;
+ foreach (@{ $result->{batches} }) {
+ if ( $_->{status} eq 'received' ) {
+ push @batches_in_transit, $_->{batch_id};
+ }
+ }
+ return if scalar(@batches_in_transit) == 0;
+ $result = $self->https_post('/batch/receive',
+ { batch_id => \@batches_in_transit });
+ # this shouldn't contain errors, since the server just told us
+ # that the batches exist...
+ foreach (@$result) {
+ if ( $_->{error} ) {
+ die "Error receiving batch: ".$_->{error}."\n";
+ }
+ }
+# $self->https_post('/batch/close', {
+# login => $self->login,
+# password => $self->password,
+# batch_id => \@batches_in_transit,
+ @$result;
}
=head1 AUTHOR
perldoc Business::BatchPayment::CardFortress
-Commercial support is available from Freeside Internet Services, Inc.
+For information about the CardFortress system, contact Freeside Internet
+Services, Inc.
L<http://www.freeside.biz>
=head1 LICENSE AND COPYRIGHT
-Copyright 2012 Mark Wells.
+Copyright 2013 Mark Wells.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published