package Business::BatchPayment::BillBuddy;

use strict;

=head1 NAME

Business::BatchPayment::BillBuddy - BillBuddy batch payment format and transport

=head1 USAGE

See L<Business::BatchPayment> for general usage notes.

=head2 SYNOPSIS

	use Business::BatchPayment;

	# Upload batch
	my @items = Business::BatchPayment::Item->new( ... );
	my $batch = Business::BatchPayment->create(Batch =>
	  batch_id  => $self->batchnum,
	  items     => \@items
	);

	my $processor = Business::BatchPayment->processor('BillBuddy',
	  login         => 'USER_ID',
	  password      => 'API_KEY',
	  host          => 'xmlrpc.billbuddy.com',
	  path          => 'v1_sandbox',
	  #optional...
	  port          => 443,
	  debug         => 1,
	);

	my $result = $processor->submit($batch);

	# this gets set by submit, and is needed for receive
	my $processor_id = $batch->processor_id;

	# Download results
	my @reply = $processor->receive(@process_ids);

=head2 PROCESSOR ATTRIBUTES

=over 4

=item username - the user_id provided to you by BillBuddy

=item password - the api_key (NOT the web portal password) provided to you by BillBuddy

=item host - the domain name for BillBuddy XMLRPC requests

=item path - the path for BillBuddy XMLRPC requests

=item port - the port for BillBuddy XMLRPC requests (optional, default 443)

=item debug - print debug warnings if true, including XML requests and responses

=back

=head1 AUTHOR

Jonathan Prykop, jonathan@freeside.biz

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Business::BatchPayment::BillBuddy

Commercial support is available from Freeside Internet Services,
L<http://www.freeside.biz> 

=head1 LICENSE AND COPYRIGHT

Copyright 2015 Freeside Internet Services

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
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut

use Business::BatchPayment;
use DateTime;
use Moose;
with 'Business::BatchPayment::Processor';

our $VERSION = '0.03';

has [ qw(username password) ] => (
   is  => 'ro',
   isa => 'Str',
);

has 'host' => (
   is  => 'ro',
   isa => 'Str',
   default => 'xmlrpc.billbuddy.com',
);

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',
    username      => $self->username,
    password      => $self->password,
    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("%010s",$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;
  $name =~ s/\'//g; # gateway should be handling this, but it's not
  $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);
  $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(username password) ] => (
   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\n" unless $rcode eq '200 OK';
  warn $response . "\n" if $self->debug;
  my $rref = XMLin($response, KeyAttr => ['ResponseData'], ForceArray => []);
  die "Error from gateway: " . $rref->{'ResponseStatusDescription'}. "\n"
    if $rref->{'ResponseStatus'};
  return $rref;
}

#gets date from batch & sets processor_id in batch
sub upload {
  my ($self,$request,$batch) = @_;
  my @tokens = ();
  # login
  my $resp = $self->xmlrpc_post('xmlrpc_tp_Login.asp','',$self->username,$self->password);
  my $sid = $resp->{'ResponseData'}->{'sessionID'};
  die "Could not parse sessionid from gateway response" unless $sid;
  # get date from login, to ensure we're using upstream date
  my ($year,$mon,$mday,$hour,$min,$sec) = $resp->{'ResponseTimestamp'} =~ /^(....)-(..)-(..)\s+(..):(..):(..)/;
  # then add a day and a bit, because "processs date need to be a date in the future"
  my $date = DateTime->new(
    year      => $year,
    month     => $mon,
    day       => $mday,
    hour      => $hour,
    minute    => $min,
    second    => $sec,
    # timezone on object mostly doesn't matter,
    # but this does appear to be the tz being passed by BillBuddy,
    # and this should avoid DST troubles (Queensland does not do DST)
    time_zone => 'Australia/Queensland',
  )->add_duration(
    # extra hour is buffer for upload to run, hopefully that's plenty
    DateTime::Duration->new( hours => 25 )
  )->ymd;
  # start a payment batch
  $resp = $self->xmlrpc_post('xmlrpc_tp_DDRBatch_Open.asp',$sid,$self->username,$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->username,$batchno,['cdataElement',$line]);
  }
  # close payment batch
  $self->xmlrpc_post('xmlrpc_tp_DDRBatch_Close.asp',$sid,$self->username,$batchno);
  # submit payment batch
  $self->xmlrpc_post('xmlrpc_tp_DDRBatch_Submit.asp',$sid,$self->username,$batchno);
  # logout
  $self->xmlrpc_post('xmlrpc_tp_Logout.asp',$sid,$self->username);
  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->username,$self->password);
  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->username,$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->username,$tid);
      my $status = lc($resp->{'ResponseData'}->{'bankprocessstatus'});
      my $error = '';
      next if grep(/^$status$/,('submitted','processing','scheduled'));
      $error = "Unknown return status: $status"
        unless grep(/^$status$/,('approved','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 => '',
      );
      if ($resp->{'ResponseData'}->{'actualprocessdate'} =~ /^(\d\d\d\d).(\d\d).(\d\d)/) {
        $item->payment_date(
          DateTime->new(
            year      => $1,
            month     => $2,
            day       => $3,
            # this appears to be the tz being passed by BillBuddy
            time_zone => 'Australia/Queensland',
          )
        );
      } else {
        warn "Could not parse actualprocessdate ".$resp->{'ResponseData'}->{'actualprocessdate'};
      }
      push(@batchitems,$item);
    }
    if (@batchitems) {
      push(@batches, Business::BatchPayment->create('Batch', items => \@batchitems));
    }
  }
  # logout
  $self->xmlrpc_post('xmlrpc_tp_Logout.asp',$sid,$self->username);
  return @batches;
}

1;

