+package Business::BatchPayment::BillBuddy;
+
+use strict;
+
+use Business::BatchPayment;
+use Moose;
+with 'Business::BatchPayment::Processor';
+
+our $VERSION = '0.01';
+
+has [ qw(user_id api_key host) ] => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+);
+
+has 'path' => (
+ is => 'ro',
+ isa => 'Str',
+ default => '/',
+);
+
+has 'port' => (
+ is => 'ro',
+ isa => 'Str',
+ default => '443',
+);
+
+sub default_transport {
+ my $self = shift;
+ Business::BatchPayment->create('BillBuddy::Transport',
+ user_id => $self->user_id,
+ api_key => $self->api_key,
+ host => $self->host,
+ port => $self->port,
+ path => $self->path,
+ debug => $self->debug,
+ );
+}
+
+sub format_item {
+ my ($self,$item,$batch) = @_;
+ #Position Length Content
+ #1-1 1 "D"
+ my $line = 'D';
+ #2-17 16 Reference Number
+ $line .= sprintf("%-16s",$item->tid);
+ #18-18 1 blank, filled with space
+ $line .= ' ';
+ #19-28 10 amount, numbers only, by cents, zero padded to the left
+ $line .= sprintf("%10s",$item->amount * 100);
+ #29-30 2 blank, filled with spaces
+ $line .= ' ';
+ #31-32 2 account type: "BC" for bank account, "CC" for credit card account
+ my $pt = $item->payment_type;
+ if ($pt eq 'CC') {
+ #we currently don't support CC, but leaving the code in place for future development
+ die 'Business::BatchPayment::BillBuddy currently does not handle credit card transactions';
+ $line .= 'CC';
+ } elsif ($pt eq 'ECHECK') {
+ $line .= 'BC';
+ } else {
+ die "Unknown payment type";
+ }
+ #33-33 1 blank
+ $line .= ' ';
+ #34-40 7 BSB for bank account, formatted in 000-000. blank for credit card account
+ my $bsb = ($pt eq 'CC') ? sprintf("%7s",'') : $item->routing_code;
+ $bsb =~ s/^(\d{3})(\d{3})/$1\-$2/;
+ die "Bad routing code $bsb" if ($pt ne 'CC') && ($bsb !~ /^\d{3}\-\d{3}$/);
+ $line .= $bsb;
+ #41-41 1 blank
+ $line .= ' ';
+ #42-50 9 Account number for bank accounts. blank for credit card account
+ my $anum = ($pt eq 'CC') ? sprintf("%9s",'') : sprintf("%09s",$item->account_number);
+ $line .= $anum;
+ #51-66 16 credit card number, left padded with zero if less than 16 digits. Blank for bank accounts
+ my $cnum = ($pt eq 'CC') ? sprintf("%016s",$item->card_number) : sprintf("%16s",'');
+ $line .= $cnum;
+ #67-98 32 bank account name or name on the credit card
+ my $name = $item->first_name . ' ' . $item->last_name;
+ $line .= sprintf("%-32.32s",$name);
+ #99-99 1 blank
+ $line .= ' ';
+ #100-103 4 credit card expiry date, formatted as mmdd. "0000" for bank account.
+ my $exp = ($pt eq 'CC') ? $item->expiration : '';
+ $line .= sprintf("%04s",$exp);
+ #104-104 1 blank
+ #105-111 7 reserved, always "0000000"
+ #112-114 3 reserved, blank
+ $line .= ' 0000000 ';
+ #115-120 6 line number, left padded with zero
+ $line .= sprintf("%06s",$batch->num);
+ $line .= "\n";
+ return $line;
+}
+
+#overriding this just to be able to pass batch to upload
+#but maybe this should go in standard module?
+sub submit {
+ my $self = shift;
+ my $batch = shift;
+ my $request = $self->format_request($batch);
+ warn $request if $self->debug >= 2;
+ $self->transport->upload($request,$batch);
+}
+
+#overriding this to pass process_ids to download,
+#but maybe this should go in standard module?
+sub receive {
+ my $self = shift;
+ return $self->transport->download(@_);
+}
+
+package Business::BatchPayment::BillBuddy::Transport;
+
+use XML::Simple qw(:strict);
+use XML::Writer;
+
+use Moose;
+extends 'Business::BatchPayment::Transport::HTTPS';
+
+has [ qw(user_id api_key) ] => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+);
+
+has 'path' => (
+ is => 'ro',
+ isa => 'Str',
+ default => '',
+);
+
+has 'debug' => (
+ is => 'rw',
+ isa => 'Int',
+ default => 0,
+);
+
+# this is really specific to BillBuddy, not a generic XML formatting routine
+sub xml_format {
+ my ($self,$sid,@param) = @_;
+ my $out;
+ my $xml = XML::Writer->new(
+ OUTPUT => \$out,
+ ENCODING => 'UTF-8',
+ );
+ $xml->startTag('postdata');
+ $xml->dataElement('sessionid',$sid);
+ $xml->dataElement('clientidentifier','');
+ $xml->startTag('parameters');
+ foreach my $param (@param) {
+ if (ref($param) eq 'ARRAY') {
+ my $type = $$param[0];
+ my $value = $$param[1];
+ $xml->$type('parameter',$value);
+ } else {
+ $xml->dataElement('parameter',$param);
+ }
+ }
+ $xml->endTag('parameters');
+ $xml->endTag('postdata');
+ $xml->end();
+ return $out;
+}
+
+# also specific to BillBuddy, doesn't actually follow XMLRPC standard for response
+sub xmlrpc_post {
+ my ($self,$func,$sid,@param) = @_;
+ my $path = $self->path;
+ $path = '/' . $path unless $path =~ /^\//;
+ $path .= '/' unless $path =~ /\/$/;
+ $path .= $func;
+ my $xmlcontent = $self->xml_format($sid,@param);
+ warn $self->host . ' ' . $self->port . ' ' . $path . "\n" . $xmlcontent if $self->debug;
+ my ($response, $rcode, %rheaders) = $self->https_post($path,$xmlcontent);
+ die "Bad response from gateway: $rcode" unless $rcode eq '200 OK';
+ warn $response . "\n" if $self->debug;
+ my $rref = XMLin($response, KeyAttr => ['ResponseData'], ForceArray => []);
+ die "Error from gateway: " . $rref->{'ResponseStatusDescription'} if $rref->{'ResponseStatus'};
+ return $rref;
+}
+
+#gets date from batch & sets processor_id in batch
+sub upload {
+ my ($self,$request,$batch) = @_;
+ my @tokens = ();
+ # get date from batch
+ my ($date) = $batch->process_date =~ /^(....-..-..)/;
+ # login
+ my $resp = $self->xmlrpc_post('xmlrpc_tp_Login.asp','',$self->user_id,$self->api_key);
+ my $sid = $resp->{'ResponseData'}->{'sessionID'};
+ die "Could not parse sessionid from gateway response" unless $sid;
+ # start a payment batch
+ $resp = $self->xmlrpc_post('xmlrpc_tp_DDRBatch_Open.asp',$sid,$self->user_id,$date);
+ my $batchno = $resp->{'ResponseData'}->{'batchno'};
+ die "Could not parse batchno from gateway response" unless $batchno;
+ $batch->processor_id($batchno);
+ # post a payment transaction
+ foreach my $line (split(/\n/,$request)) {
+ $self->xmlrpc_post('xmlrpc_tp_DDRTransaction_Add.asp',$sid,$self->user_id,$batchno,['cdataElement',$line]);
+ }
+ # close payment batch
+ $self->xmlrpc_post('xmlrpc_tp_DDRBatch_Close.asp',$sid,$self->user_id,$batchno);
+ # submit payment batch
+ $self->xmlrpc_post('xmlrpc_tp_DDRBatch_Submit.asp',$sid,$self->user_id,$batchno);
+ # logout
+ $self->xmlrpc_post('xmlrpc_tp_Logout.asp',$sid,$self->user_id);
+ return '';
+}
+
+# caution--this method developed without access to completed test payments
+# built with best guesses, cross your fingers...
+sub download {
+ my $self = shift;
+ my @processor_ids = @_;
+ return () unless @processor_ids;
+ # login
+ my $resp = $self->xmlrpc_post('xmlrpc_tp_Login.asp','',$self->user_id,$self->api_key);
+ my $sid = $resp->{'ResponseData'}->{'sessionID'};
+ die "Could not parse sessionid from gateway response" unless $sid;
+ my @batches = ();
+ foreach my $batchno (@processor_ids) {
+ #get BillBuddy transaction ids for batch
+ $resp = $self->xmlrpc_post('xmlrpc_tp_DDRBatch_getTranList.asp',$sid,$self->user_id,$batchno);
+ my $tids = $resp->{'ResponseData'}->{'id'};
+ next unless $tids; #error/die instead?
+ my @batchitems = ();
+ $tids = ref($tids) ? $tids : [ $tids ];
+ #get status by individual transaction
+ foreach my $tid (@$tids) {
+ $resp = $self->xmlrpc_post('xmlrpc_tp_DDRBatch_getTranStatus.asp',$sid,$self->user_id,$tid);
+ my $status = lc($resp->{'ResponseData'}->{'bankprocessstatus'});
+ my $error = '';
+ next if grep(/^$status$/,('submitted','processing','scheduled'));
+ $error = "Unknown return status: $status"
+ unless grep(/^$status$/,('deleted','declined'));
+ my $item = Business::BatchPayment->create(Item =>
+ order_number => $tid,
+ tid => $resp->{'ResponseData'}->{'referencenumber'},
+ approved => ($status eq 'approved') ? 1 : 0,
+ error_message => $error,
+ authorization => '',
+ );
+ #not sure what format date gets returned in, item creation will fail on bad format,
+ #so I'm taking a guess, and not recording the date if my guess is wrong
+ if ($resp->{'ResponseData'}->{'actualprocessdate'} =~ /^(\d\d\d\d).(\d\d).(\d\d)/) {
+ $item->payment_date($1.'-'.$2.'-'.$3);
+ }
+ push(@batchitems,$item);
+ }
+ if (@batchitems) {
+ push(@batches, Business::BatchPayment->create('Batch', items => \@batchitems));
+ }
+ }
+ # logout
+ $self->xmlrpc_post('xmlrpc_tp_Logout.asp',$sid,$self->user_id);
+ return @batches;
+}
+
+1;
+
projects / Business-BatchPayment-BillBuddy.git / commitdiff