package Business::OnlinePayment::WesternACH;

use strict;
use Carp;
use Business::OnlinePayment 3;
use Business::OnlinePayment::HTTPS;
use XML::Simple;
use vars qw($VERSION @ISA $me $DEBUG);

@ISA = qw(Business::OnlinePayment::HTTPS);
$VERSION = '0.02';
$me = 'Business::OnlinePayment::WesternACH';

$DEBUG = 0;

my $defaults = {
  command      => 'payment',
  check_ver    => 'yes',
  sec_code     => 'WEB',
  tender_type  => 'check',
  check_number => 9999,
  schedule     => 'live',
};

# Structure of the XML request document
# Right sides of the hash entries are Business::OnlinePayment 
# field names.  Those that start with _ are local method names.

my $request = {
TransactionRequest => {
  Authentication => {
    username => 'login',
    password => 'password',
  },
  Request => {
    command => 'command',
    Payment => {
      type   => '_payment_type',
      amount => 'amount',
      # effective date: not supported
      Tender => {
        type   => 'tender_type',
        amount => 'amount',
        InvoiceNumber => { value => 'invoice_number' },
        AccountHolder => { value => '_full_name'      },
        Address       => { value => 'address'       },
        ClientID      => { value => 'customer_id'    },
        CheckDetails => {
          routing      => 'routing_code',
          account      => 'account_number',
          check        => 'check_number',
          type         => '_check_type',
          verification => 'check_ver',
        },
        Authorization => { schedule => 'schedule' },
        SECCode => { value => 'sec_code' },
      },
    },
  }
}
};

sub set_defaults {
  my $self = shift;
  $self->server('www.webcheckexpress.com');
  $self->port(443);
  $self->path('/requester.php');
  return;
}

sub submit {
  my $self = shift;
  $Business::OnlinePayment::HTTPS::DEBUG = $DEBUG;

  eval {
    # Return-with-error situations
    croak "Unsupported transaction type: '" . $self->transaction_type . "'"
      if(not $self->transaction_type =~ /^e?check$/i);

    croak "Unsupported action: '" . $self->{_content}->{action} . "'"
      if(!defined($self->_payment_type));

    croak 'Test transactions not supported'
      if($self->test_transaction());
  };

  if($@) {
    $self->is_success(0);
    $self->error_message($@);
    return;
  }
  
  my $xml_request = XMLout($self->build($request), KeepRoot => 1);
  
  my ($xml_reply, $response, %reply_headers) = $self->https_post({ 'Content-Type' => 'text/xml' }, $xml_request);
  
  if(not $response =~ /^200/) {
    croak "HTTPS error: '$response'";
  }

  $self->server_response($xml_reply);
  my $reply = XMLin($xml_reply, KeepRoot => 1)->{TransactionResponse};

  if(exists($reply->{Response})) {
    $self->is_success( ( $reply->{Response}->{status} eq 'successful') ? 1 : 0);
    $self->error_message($reply->{Response}->{ErrorMessage});
  }
  elsif(exists($reply->{FatalException})) {
    $self->is_success(0);
    $self->error_message($reply->{FatalException});
  }

  $DB::single = 1 if $DEBUG;

  return;
}

sub build {
  my $self = shift;
  my $content = { $self->content };
  my $skel = shift;
  my $data;
  if (ref($skel) ne 'HASH') { croak 'Failed to build non-hash' };
  foreach my $k (keys(%$skel)) {
    my $val = $skel->{$k};
    # Rules for building from the skeleton:
    # 1. If the value is a hashref, build it recursively.
    if(ref($val) eq 'HASH') {
      $data->{$k} = $self->build($val);
    }
    # 2. If the value starts with an underscore, it's treated as a method name.
    elsif($val =~ /^_/ and $self->can($val)) {
      $data->{$k} = $self->can($val)->($self);
    }
    # 3. If the value is undefined, keep it undefined.
    elsif(!defined($val)) {
      $data->{$k} = undef;
    }
    # 4. If the value is the name of a key in $self->content, look up that value.
    elsif(exists($content->{$val})) {
      $data->{$k} = $content->{$val};
    }
    # 5. If the value is a key in $defaults, use that value.
    elsif(exists($defaults->{$val})) {
      $data->{$k} = $defaults->{$val};
    }
    # 6. Fail.
    else {
      croak "Missing request field: '$val'";
    }
  }
  return $data;
}

sub XML {
  # For testing build().
  my $self = shift;
  return XMLout($self->build($request), KeepRoot => 1);
}

sub _payment_type {
  my $self = shift;
  my $action = $self->{_content}->{action};
  if(!defined($action) or $action =~ /^normal authorization$/i) {
    return 'debit';
  }
  elsif($action =~ /^credit$/i) {
    return 'credit';
  }
  else {
    return;
  }
}

sub _check_type {
  my $self = shift;
  my $type = $self->{_content}->{account_type};
  return 'checking' if($type =~ /checking/i);
  return 'savings'  if($type =~ /savings/i);
  croak "Invalid account_type: '$type'";
}

sub _full_name {
  my $self = shift;
  return join(' ',$self->{_content}->{first_name},$self->{_content}->{last_name});
}

1;
__END__

=head1 NAME

Business::OnlinePayment::WesternACH - Western ACH backend for Business::OnlinePayment

=head1 SYNOPSIS

  use Business::OnlinePayment;

  ####
  # Electronic check authorization.  We only support 
  # 'Normal Authorization' and 'Credit'.
  ####

  my $tx = new Business::OnlinePayment("AuthorizeNet");
  $tx->content(
      type           => 'ECHECK',
      login          => 'testdrive',
      password       => 'testpass',
      action         => 'Normal Authorization',
      description    => 'Business::OnlinePayment test',
      amount         => '49.95',
      invoice_number => '100100',
      first_name     => 'Jason',
      last_name      => 'Kohles',
      address        => '123 Anystreet',
      city           => 'Anywhere',
      state          => 'UT',
      zip            => '84058',
      account_type   => 'personal checking',
      account_number => '1000468551234',
      routing_code   => '707010024',
      check_number   => '1001', # optional
  );
  $tx->submit();

  if($tx->is_success()) {
      print "Check processed successfully: ".$tx->authorization."\n";
  } else {
      print "Check was rejected: ".$tx->error_message."\n";
  }

=head1 SUPPORTED TRANSACTION TYPES

=head2 ECHECK

Content required: type, login, password|transaction_key, action, amount, first_name, last_name, account_number, routing_code, account_type.

=head1 DESCRIPTION

For detailed information see L<Business::OnlinePayment>.

=head1 METHODS AND FUNCTIONS

See L<Business::OnlinePayment> for the complete list. The following methods either override the methods in L<Business::OnlinePayment> or provide additional functions.  

=head2 result_code

Currently returns nothing; these transactions don't seem to have result codes.

=head2 error_message

Returns the response reason text.  This can come from several locations in the response document or from certain local errors.

=head2 server_response

Returns the complete response from the server.

=head1 Handling of content(%content) data:

=head2 action

The following actions are valid:

  normal authorization
  credit

=head1 AUTHOR

Mark Wells <mark@freeside.biz> with advice from Ivan Kohler <ivan-westernach@freeside.biz>.

=head1 SEE ALSO

perl(1). L<Business::OnlinePayment>.

=cut