BillBuddy.pm

   1 package Business::BatchPayment::BillBuddy;
   2
   3 use strict;
   4
   5 =head1 NAME
   6
   7 Business::BatchPayment::BillBuddy - BillBuddy batch payment format and transport
   8
   9 =head1 USAGE
  10
  11 See L<Business::BatchPayment> for general usage notes.
  12
  13 =head2 SYNOPSIS
  14
  15         use Business::BatchPayment;
  16
  17         # Upload batch
  18         my @items = Business::BatchPayment::Item->new( ... );
  19         my $batch = Business::BatchPayment->create(Batch =>
  20           batch_id  => $self->batchnum,
  21           items     => \@items
  22         );
  23
  24         my $processor = Business::BatchPayment->processor('BillBuddy',
  25           login         => 'USER_ID',
  26           password      => 'API_KEY',
  27           host          => 'xmlrpc.billbuddy.com',
  28           path          => 'v1_sandbox',
  29           #optional...
  30           port          => 443,
  31           debug         => 1,
  32         );
  33
  34         my $result = $processor->submit($batch);
  35
  36         # this gets set by submit, and is needed for receive
  37         my $processor_id = $batch->processor_id;
  38
  39         # Download results
  40         my @reply = $processor->receive(@process_ids);
  41
  42 =head2 PROCESSOR ATTRIBUTES
  43
  44 =over 4
  45
  46 =item username - the user_id provided to you by BillBuddy
  47
  48 =item password - the api_key (NOT the web portal password) provided to you by BillBuddy
  49
  50 =item host - the domain name for BillBuddy XMLRPC requests
  51
  52 =item path - the path for BillBuddy XMLRPC requests
  53
  54 =item port - the port for BillBuddy XMLRPC requests (optional, default 443)
  55
  56 =item debug - print debug warnings if true, including XML requests and responses
  57
  58 =back
  59
  60 =head1 AUTHOR
  61
  62 Jonathan Prykop, jonathan@freeside.biz
  63
  64 =head1 SUPPORT
  65
  66 You can find documentation for this module with the perldoc command.
  67
  68     perldoc Business::BatchPayment::BillBuddy
  69
  70 Commercial support is available from Freeside Internet Services,
  71 L<http://www.freeside.biz>
  72
  73 =head1 LICENSE AND COPYRIGHT
  74
  75 Copyright 2015 Freeside Internet Services
  76
  77 This program is free software; you can redistribute it and/or modify it
  78 under the terms of either: the GNU General Public License as published
  79 by the Free Software Foundation; or the Artistic License.
  80
  81 See http://dev.perl.org/licenses/ for more information.
  82
  83 =cut
  84
  85 use Business::BatchPayment;
  86 use DateTime;
  87 use Moose;
  88 with 'Business::BatchPayment::Processor';
  89
  90 our $VERSION = '0.03';
  91
  92 has [ qw(username password) ] => (
  93    is  => 'ro',
  94    isa => 'Str',
  95 );
  96
  97 has 'host' => (
  98    is  => 'ro',
  99    isa => 'Str',
 100    default => 'xmlrpc.billbuddy.com',
 101 );
 102
 103 has 'path' => (
 104    is  => 'ro',
 105    isa => 'Str',
 106    default => '/',
 107 );
 108
 109 has 'port' => (
 110    is  => 'ro',
 111    isa => 'Str',
 112    default => '443',
 113 );
 114
 115 sub default_transport {
 116   my $self = shift;
 117   Business::BatchPayment->create('BillBuddy::Transport',
 118     username      => $self->username,
 119     password      => $self->password,
 120     host          => $self->host,
 121     port          => $self->port,
 122     path          => $self->path,
 123     debug         => $self->debug,
 124   );
 125 }
 126
 127 sub format_item {
 128   my ($self,$item,$batch) = @_;
 129   #Position Length Content
 130   #1-1 1 "D"
 131   my $line = 'D';
 132   #2-17 16 Reference Number
 133   $line .= sprintf("%-16s",$item->tid);
 134   #18-18 1 blank, filled with space
 135   $line .= ' ';
 136   #19-28 10 amount, numbers only, by cents, zero padded to the left
 137   $line .= sprintf("%010s",$item->amount * 100);
 138   #29-30 2 blank, filled with spaces
 139   $line .= '  ';
 140   #31-32 2 account type: "BC" for bank account, "CC" for credit card account
 141   my $pt = $item->payment_type;
 142   if ($pt eq 'CC') {
 143     #we currently don't support CC, but leaving the code in place for future development
 144     die 'Business::BatchPayment::BillBuddy currently does not handle credit card transactions';
 145     $line .= 'CC';
 146   } elsif ($pt eq 'ECHECK') {
 147     $line .= 'BC';
 148   } else {
 149     die "Unknown payment type";
 150   }
 151   #33-33 1 blank
 152   $line .= ' ';
 153   #34-40 7 BSB for bank account, formatted in 000-000. blank for credit card account
 154   my $bsb = ($pt eq 'CC') ? sprintf("%7s",'') : $item->routing_code;
 155   $bsb =~ s/^(\d{3})(\d{3})/$1\-$2/;
 156   die "Bad routing code $bsb" if ($pt ne 'CC') && ($bsb !~ /^\d{3}\-\d{3}$/);
 157   $line .= $bsb;
 158   #41-41 1 blank
 159   $line .= ' ';
 160   #42-50 9 Account number for bank accounts. blank for credit card account
 161   my $anum = ($pt eq 'CC') ? sprintf("%9s",'') : sprintf("%09s",$item->account_number);
 162   $line .= $anum;
 163   #51-66 16 credit card number, left padded with zero if less than 16 digits. Blank for bank accounts
 164   my $cnum = ($pt eq 'CC') ? sprintf("%016s",$item->card_number) : sprintf("%16s",'');
 165   $line .= $cnum;
 166   #67-98 32 bank account name or name on the credit card
 167   my $name = $item->first_name . ' ' . $item->last_name;
 168   $name =~ s/\'//g; # gateway should be handling this, but it's not
 169   $line .= sprintf("%-32.32s",$name);
 170   #99-99 1 blank
 171   $line .= ' ';
 172   #100-103 4 credit card expiry date, formatted as mmdd. "0000" for bank account.
 173   my $exp = ($pt eq 'CC') ? $item->expiration : '';
 174   $line .= sprintf("%04s",$exp);
 175   #104-104 1 blank
 176   #105-111 7 reserved, always "0000000"
 177   #112-114 3 reserved, blank
 178   $line .= ' 0000000   ';
 179   #115-120 6 line number, left padded with zero
 180   $line .= sprintf("%06s",$batch->num);
 181   $line .= "\n";
 182   return $line;
 183 }
 184
 185 #overriding this just to be able to pass batch to upload
 186 #but maybe this should go in standard module?
 187 sub submit {
 188   my $self = shift;
 189   my $batch = shift;
 190   my $request = $self->format_request($batch);
 191   $self->transport->upload($request,$batch);
 192 }
 193
 194 #overriding this to pass process_ids to download,
 195 #but maybe this should go in standard module?
 196 sub receive {
 197   my $self = shift;
 198   return $self->transport->download(@_);
 199 }
 200
 201 package Business::BatchPayment::BillBuddy::Transport;
 202
 203 use XML::Simple qw(:strict);
 204 use XML::Writer;
 205
 206 use Moose;
 207 extends 'Business::BatchPayment::Transport::HTTPS';
 208
 209 has [ qw(username password) ] => (
 210    is  => 'ro',
 211    isa => 'Str',
 212    required => 1,
 213 );
 214
 215 has 'path' => (
 216    is  => 'ro',
 217    isa => 'Str',
 218    default => '',
 219 );
 220
 221 has 'debug' => (
 222   is => 'rw',
 223   isa => 'Int',
 224   default => 0,
 225 );
 226
 227 # this is really specific to BillBuddy, not a generic XML formatting routine
 228 sub xml_format {
 229   my ($self,$sid,@param) = @_;
 230   my $out;
 231   my $xml = XML::Writer->new(
 232     OUTPUT   => \$out,
 233     ENCODING => 'UTF-8',
 234   );
 235   $xml->startTag('postdata');
 236   $xml->dataElement('sessionid',$sid);
 237   $xml->dataElement('clientidentifier','');
 238   $xml->startTag('parameters');
 239   foreach my $param (@param) {
 240     if (ref($param) eq 'ARRAY') {
 241       my $type  = $$param[0];
 242       my $value = $$param[1];
 243       $xml->$type('parameter',$value);
 244     } else {
 245       $xml->dataElement('parameter',$param);
 246     }
 247   }
 248   $xml->endTag('parameters');
 249   $xml->endTag('postdata');
 250   $xml->end();
 251   return $out;
 252 }
 253
 254 # also specific to BillBuddy, doesn't actually follow XMLRPC standard for response
 255 sub xmlrpc_post {
 256   my ($self,$func,$sid,@param) = @_;
 257   my $path = $self->path;
 258   $path = '/' . $path unless $path =~ /^\//;
 259   $path .= '/' unless $path =~ /\/$/;
 260   $path .= $func;
 261   my $xmlcontent = $self->xml_format($sid,@param);
 262   warn $self->host . ' ' . $self->port . ' ' . $path . "\n" . $xmlcontent if $self->debug;
 263   my ($response, $rcode, %rheaders) = $self->https_post($path,$xmlcontent);
 264   die "Bad response from gateway: $rcode\n" unless $rcode eq '200 OK';
 265   warn $response . "\n" if $self->debug;
 266   my $rref = XMLin($response, KeyAttr => ['ResponseData'], ForceArray => []);
 267   die "Error from gateway: " . $rref->{'ResponseStatusDescription'}. "\n"
 268     if $rref->{'ResponseStatus'};
 269   return $rref;
 270 }
 271
 272 #gets date from batch & sets processor_id in batch
 273 sub upload {
 274   my ($self,$request,$batch) = @_;
 275   my @tokens = ();
 276   # login
 277   my $resp = $self->xmlrpc_post('xmlrpc_tp_Login.asp','',$self->username,$self->password);
 278   my $sid = $resp->{'ResponseData'}->{'sessionID'};
 279   die "Could not parse sessionid from gateway response" unless $sid;
 280   # get date from login, to ensure we're using upstream date
 281   my ($year,$mon,$mday,$hour,$min,$sec) = $resp->{'ResponseTimestamp'} =~ /^(....)-(..)-(..)\s+(..):(..):(..)/;
 282   # then add a day and a bit, because "processs date need to be a date in the future"
 283   my $date = DateTime->new(
 284     year      => $year,
 285     month     => $mon,
 286     day       => $mday,
 287     hour      => $hour,
 288     minute    => $min,
 289     second    => $sec,
 290     # timezone on object mostly doesn't matter,
 291     # but this does appear to be the tz being passed by BillBuddy,
 292     # and this should avoid DST troubles (Queensland does not do DST)
 293     time_zone => 'Australia/Queensland',
 294   )->add_duration(
 295     # extra hour is buffer for upload to run, hopefully that's plenty
 296     DateTime::Duration->new( hours => 25 )
 297   )->ymd;
 298   # start a payment batch
 299   $resp = $self->xmlrpc_post('xmlrpc_tp_DDRBatch_Open.asp',$sid,$self->username,$date);
 300   my $batchno = $resp->{'ResponseData'}->{'batchno'};
 301   die "Could not parse batchno from gateway response" unless $batchno;
 302   $batch->processor_id($batchno);
 303   # post a payment transaction
 304   foreach my $line (split(/\n/,$request)) {
 305     $self->xmlrpc_post('xmlrpc_tp_DDRTransaction_Add.asp',$sid,$self->username,$batchno,['cdataElement',$line]);
 306   }
 307   # close payment batch
 308   $self->xmlrpc_post('xmlrpc_tp_DDRBatch_Close.asp',$sid,$self->username,$batchno);
 309   # submit payment batch
 310   $self->xmlrpc_post('xmlrpc_tp_DDRBatch_Submit.asp',$sid,$self->username,$batchno);
 311   # logout
 312   $self->xmlrpc_post('xmlrpc_tp_Logout.asp',$sid,$self->username);
 313   return '';
 314 }
 315
 316 # caution--this method developed without access to completed test payments
 317 # built with best guesses, cross your fingers...
 318 sub download {
 319   my $self = shift;
 320   my @processor_ids = @_;
 321   return () unless @processor_ids;
 322   # login
 323   my $resp = $self->xmlrpc_post('xmlrpc_tp_Login.asp','',$self->username,$self->password);
 324   my $sid = $resp->{'ResponseData'}->{'sessionID'};
 325   die "Could not parse sessionid from gateway response" unless $sid;
 326   my @batches = ();
 327   foreach my $batchno (@processor_ids) {
 328     #get BillBuddy transaction ids for batch
 329     $resp = $self->xmlrpc_post('xmlrpc_tp_DDRBatch_getTranList.asp',$sid,$self->username,$batchno);
 330     my $tids = $resp->{'ResponseData'}->{'id'};
 331     next unless $tids; #error/die instead?
 332     my @batchitems = ();
 333     $tids = ref($tids) ? $tids : [ $tids ];
 334     #get status by individual transaction
 335     foreach my $tid (@$tids) {
 336       $resp = $self->xmlrpc_post('xmlrpc_tp_DDRBatch_getTranStatus.asp',$sid,$self->username,$tid);
 337       my $status = lc($resp->{'ResponseData'}->{'bankprocessstatus'});
 338       my $error = '';
 339       next if grep(/^$status$/,('submitted','processing','scheduled'));
 340       $error = "Unknown return status: $status"
 341         unless grep(/^$status$/,('deleted','declined'));
 342       my $item = Business::BatchPayment->create(Item =>
 343         order_number  => $tid,
 344         tid           => $resp->{'ResponseData'}->{'referencenumber'},
 345         approved      => ($status eq 'approved') ? 1 : 0,
 346         error_message => $error,
 347         authorization => '',
 348       );
 349       if ($resp->{'ResponseData'}->{'actualprocessdate'} =~ /^(\d\d\d\d).(\d\d).(\d\d)/) {
 350         $item->payment_date($1.'-'.$2.'-'.$3);
 351       } else {
 352         warn "Could not parse actualprocessdate ".$resp->{'ResponseData'}->{'actualprocessdate'};
 353       }
 354       push(@batchitems,$item);
 355     }
 356     if (@batchitems) {
 357       push(@batches, Business::BatchPayment->create('Batch', items => \@batchitems));
 358     }
 359   }
 360   # logout
 361   $self->xmlrpc_post('xmlrpc_tp_Logout.asp',$sid,$self->username);
 362   return @batches;
 363 }
 364
 365 1;
 366