initial version

diff --git a/CardFortress.pm b/CardFortress.pm
index 3690f1c..33b7ee1 100644 (file)
--- a/CardFortress.pm
+++ b/CardFortress.pm
@@ -99,13 +99,12 @@ sub format_request {
   # 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;
@@ -130,14 +129,18 @@ extends 'Business::BatchPayment::Transport::HTTPS';
 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,
 );
@@ -146,49 +149,93 @@ has ['login', 'password', 'private_key'] => (isa => 'Str', is => 'rw');
 
 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
@@ -201,7 +248,8 @@ You can find documentation for this module with the perldoc command.
 
     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>
 
@@ -209,7 +257,7 @@ 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

diff --git a/Changes b/Changes
index 8e4fd70..803e94d 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,3 @@
 Revision history for Business-BatchPayment-CardFortress
 
-0.01    Date/time
-        First version, released on an unsuspecting world.
-
+0.01    unreleased