File Coverage

blib/lib/Business/OnlinePayment/Vanco.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Business::OnlinePayment::Vanco;

use strict;
use Carp;
use Tie::IxHash;
use XML::Simple;
use XML::Writer;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Request::Common qw (POST);
use Date::Calc qw(Add_Delta_YM Add_Delta_Days);
use Business::OnlinePayment;
#use Business::OnlinePayment::HTTPS;
use vars qw($VERSION $DEBUG @ISA $me);

@ISA = qw(Business::OnlinePayment);  # Business::OnlinePayment::HTTPS
$VERSION = '0.02';
$DEBUG = 0;
$me = 'Business::OnlinePayment::Vanco';

sub set_defaults {
    my $self = shift;
    my %opts = @_;

    # standard B::OP methods/data
    $self->server('www.vancoservices.com') unless $self->server;
    $self->port('443') unless $self->port;
    $self->path('/cgi-bin/ws.vps') unless $self->path;

    $self->build_subs(qw( order_number avs_code cvv2_response
                          response_page response_code response_headers
                     ));

    # module specific data
    foreach (qw( ClientID ProductID )) {
      $self->build_subs($_);

      if ( $opts{$_} ) {
          $self->$_( $opts{$_} );
          delete $opts{$_};
      }
    }

}

sub map_fields {
    my($self) = @_;

    my %content = $self->content();
    my $action = lc($content{'action'});

    # ACTION MAP
    my %actions =
      ( 'normal authorization'            => 'EFTAddCompleteTransaction',
        'recurring authorization'         => 'EFTAddCompleteTransaction',
        'cancel recurring authorization'  => 'EFTDeleteTransaction',
      );
    $content{'RequestType'} = $actions{$action} || $action;

    # TYPE MAP
    my %types = ( 'visa'               => 'CC',
                  'mastercard'         => 'CC',
                  'american express'   => 'CC',
                  'discover'           => 'CC',
                  'check'              => 'ECHECK',
                );
    $content{'type'} = $types{lc($content{'type'})} || $content{'type'};
    $self->transaction_type($content{'type'});

    # CHECK/TRANSACTION TYPE MAP
    $content{'TransactionTypeCode'} = $content{'check_type'} || 'PPD'
      unless ( $content{'TransactionTypeCode'}
            || $content{'RequestType'} eq 'EFTDeleteTransaction'); # kludgy

    # let FrequencyCode, StartDate, and EndDate be specified directly;
    unless($content{FrequencyCode}){
      my ($length,$unit) =
        ($self->{_content}->{interval} or '') =~
          /^\s*(\d+)\s+(day|month)s?\s*$/;

      my %daily   = (  '7' => 'W',
                      '14' => 'BW',
                    );

      my %monthly = (  '1' => 'M',
                       '3' => 'Q',
                      '12' => 'A',
                    );

      if ($length && $unit) {
        $content{'FrequencyCode'} = $daily{$length}
          if ($unit eq 'day');

        $content{'FrequencyCode'} = $monthly{$length}
          if ($unit eq 'month');
      }
    }

    unless($content{StartDate}){
      $content{'StartDate'} = $content{'start'};
    }

    unless($content{EndDate}){
      my ($year,$month,$day) =
        $content{StartDate} =~ /^\s*(\d{4})-(\d{1,2})-(\d{1,2})\s*$/
        if $content{StartDate};

      my ($periods) = $content{periods} =~/^\s*(\d+)\s*$/
        if $content{periods};

      my %daily   = (  'W' => '7',
                      'BW' => '14',
                    );

      my %monthly = (  'M' => '1',
                       'Q' => '3',
                       'A' => '12',
                    );

      if ($year && $month && $day && $periods) {
        if ($daily{$content{FrequencyCode}}) {
          my $days = ($periods - 1) * $daily{$content{FrequencyCode}};
          ($year, $month, $day) = Add_Delta_Days( $year, $month, $day, $days);
          $content{EndDate} = sprintf("%04d-%02d-%02d", $year, $month, $day);
        }

        if ($monthly{$content{FrequencyCode}}) {
          my $months = ($periods - 1) * $monthly{$content{FrequencyCode}};
          ($year, $month, $day) = Add_Delta_YM( $year, $month, $day, 0, $months);
          $content{EndDate} = sprintf("%04d-%02d-%02d", $year, $month, $day);
        }
      }

    }

    if ($action eq 'normal authorization'){
      my $time = time + 86400 if $self->transaction_type() eq 'ECHECK';
      $content{'FrequencyCode'} = 'O';
      $content{'StartDate'} = $content{'start'} || substr(today($time),0,10);
      $content{'EndDate'} = $content{'StartDate'};
    }


    # ACCOUNT TYPE MAP
    my %account_types = ('personal checking'   => 'C',
                         'personal savings'    => 'S',
                         'business checking'   => 'C',
                         'business savings'    => 'S',
                         'checking'            => 'C',
                         'savings'             => 'S',
                        );
    $content{'account_type'} = $account_types{lc($content{'account_type'})}
                               || $content{'account_type'};
    $content{'account_type'} = 'CC' if lc($content{'type'}) eq 'cc';

    # SHIPPING INFORMATION
    foreach (qw(name address city state zip)) {
      $content{"ship_$_"} = $content{$_} unless $content{"ship$_"};
    }

    # stuff it back into %content
    $self->content(%content);

}

sub expdate_month {
  my ($self, $exp) = (shift, shift);
  my $month;
  if ( defined($exp) and $exp =~ /^(\d+)\D+\d*\d{2}$/ ) {
    $month  = sprintf( "%02d", $1 );
  }elsif ( defined($exp) and $exp =~ /^(\d{2})\d{2}$/ ) {
    $month  = sprintf( "%02d", $1 );
  }
  return $month;
}

sub expdate_year {
  my ($self, $exp) = (shift, shift);
  my $year;
  if ( defined($exp) and $exp =~ /^\d+\D+\d*(\d{2})$/ ) {
    $year  = sprintf( "%02d", $1 );
  }elsif ( defined($exp) and $exp =~ /^\d{2}(\d{2})$/ ) {
    $year  = sprintf( "%02d", $1 );
  }
  return $year;
}

sub today {
  my @time = localtime($_[0] ? shift : time);
  $time[5] += 1900;
  $time[4]++;
  sprintf("%04d-%02d-%02d %02d:%02d:%02d", reverse(@time[0..5]));
}

sub revmap_fields {
  my $self = shift;
  tie my(%map), 'Tie::IxHash', @_;
  my %content = $self->content();
  map {
        my $value;
        if ( ref( $map{$_} ) eq 'HASH' ) {
          $value = $map{$_} if ( keys %{ $map{$_} } );
        }elsif( ref( $map{$_} ) ) {
          $value = ${ $map{$_} };
        }elsif( exists( $content{ $map{$_} } ) ) {
          $value = $content{ $map{$_} };
        }

        if (defined($value)) {
          ($_ => $value);
        }else{
          ();
        }
      } (keys %map);
}

sub submit {
  my($self) = @_;

  $self->is_success(0);
  unless($self->ClientID() && $self->ProductID()) {
    croak "ClientID and ProductID are required";
  }

  my $requestid = time . sprintf("%010u", rand() * 2**32);
  my $auth_requestid = $requestid . '0';
  my $req_requestid  = $requestid . '1';

  $self->map_fields();

  my @required_fields = qw(action login password);

  if ( lc($self->{_content}->{action}) eq 'normal authorization' ) {
    push @required_fields, qw( type amount name );

    push @required_fields, qw( card_number expiration )
      if ($self->transaction_type() eq "CC");

    push @required_fields,
      qw( routing_code account_number account_type )
      if ($self->transaction_type() eq "ECHECK");

  }elsif ( lc($self->{_content}->{action}) eq 'recurring authorization' ) {
    push @required_fields, qw( type interval start periods amount name );

    push @required_fields, qw( card_number expiration )
      if ($self->transaction_type() eq 'CC' );

    push @required_fields,
      qw( routing_code account_number account_type )
      if ($self->transaction_type() eq "ECHECK");

  }elsif ( lc($self->{_content}->{action}) eq 'cancel recurring authorization' ) {
    push @required_fields, qw( subscription );

  }else{
    croak "$me can't handle transaction type: ".
      $self->{_content}->{action}. " for ".
      $self->transaction_type();
  }

  $self->required_fields(@required_fields);

  tie my %auth, 'Tie::IxHash', (
                                 RequestType => 'Login',
                                 RequestID   => $auth_requestid,
                                 RequestTime => today(),
                               );

  tie my %requestvars, 'Tie::IxHash',
    $self->revmap_fields(
                          UserID      => 'login',
                          Password    => 'password',
                        );
  $requestvars{'ProductID'} = $self->ProductID();

  tie my %req, 'Tie::IxHash',
    $self->revmap_fields (
                           Auth    => \%auth,
                           Request => { RequestVars => \%requestvars },
                         );

  my $response = $self->_my_https_post(%req);
  return if $self->result_code();

  tie %auth, 'Tie::IxHash',
    $self->revmap_fields( RequestType => 'RequestType');
  $auth{'RequestID'}   = $req_requestid;
  $auth{'RequestTime'} = today();
  $auth{'SessionID'}   = $response->{Response}->{SessionID};

  my $client_id = $self->ClientID();
  my $cardexpmonth = $self->expdate_month($self->{_content}->{expiration});
  my $cardexpyear  = $self->expdate_year($self->{_content}->{expiration});
  my $account_number = ( defined($self->transaction_type())
                         && $self->transaction_type() eq 'CC')
                       ? $self->{_content}->{card_number}
                       : $self->{_content}->{account_number}
  ;

  tie %requestvars, 'Tie::IxHash',
    $self->revmap_fields(
                          ClientID            => \$client_id,
                          CustomerID          => 'customer_id',
                          CustomerName        => 'ship_name',   # defaults to
                          CustomerAddress1    => 'ship_address',# values without
                          CustomerCity        => 'ship_city',   # ship_ prefix
                          CustomerState       => 'ship_state',  #
                          CustomerZip         => 'ship_zip',    #
                          CustomerPhone       => 'phone',
                          AccountType         => 'account_type',
                          AccountNumber       => \$account_number,
                          RoutingNumber       => 'routing_code',
                          CardBillingName     => 'name',
                          CardExpMonth        => \$cardexpmonth,
                          CardExpYear         => \$cardexpyear,
                          CardCVV2            => 'cvv2',
                          CardBillingAddr1    => 'address',
                          CardBillingCity     => 'city',
                          CardBillingState    => 'state',
                          CardBillingZip      => 'zip',
                          Amount              => 'amount',
                          StartDate           => 'StartDate',
                          EndDate             => 'EndDate',
                          FrequencyCode       => 'FrequencyCode',
                          TransactionTypeCode => 'TransactionTypeCode',
                          TransactionRef      => 'subscription',
                        );

  tie %req, 'Tie::IxHash',
    $self->revmap_fields (
                           Auth    => \%auth,
                           Request => { RequestVars => \%requestvars },
                         );

  $response = $self->_my_https_post(%req);
  $self->order_number($response->{Response}->{TransactionRef});

  $self->is_success(1);
  if ($self->result_code()) {
    $self->is_success(0);
    unless ( $self->error_message() ) { #additional logging information
      my %headers = %{$self->response_headers()};
      $self->error_message(
        "(HTTPS response: ". $self->result_code(). ") ".
        "(HTTPS headers: ".
          join(", ", map { "$_ => ". $headers{$_} } keys %headers ). ") ".
        "(Raw HTTPS content: ". $self->server_response(). ")"
      );
    }
  }

}

sub _my_https_post {
  my $self = shift;
  my %req = @_;
  my $post_data;
  my $writer = new XML::Writer( OUTPUT      => \$post_data,
                                DATA_MODE   => 1,
                                DATA_INDENT => 1,
#                                ENCODING    => 'us-ascii',
                              );
  $writer->xmlDecl();
  $writer->startTag('VancoWS');
  foreach ( keys ( %req ) ) {
    $self->_xmlwrite($writer, $_, $req{$_});
  }
  $writer->endTag('VancoWS');
  $writer->end();

  if ($self->test_transaction()) {
    $self->server('www.vancodev.com');
    $self->port('443');
    $self->path('/cgi-bin/wstest.vps');
  }

  my $url = "https://" . $self->server. ':';
  $url .= $self->port || '443';
  $url .= $self->path;

  my $ua = new LWP::UserAgent;
  my $res = $ua->request( POST( $url, 'Content_Type' => 'form-data',
                                      'Content' => [ 'xml' => $post_data ])
                        );

  warn $post_data if $DEBUG;
  my($page,$server_response,%headers) =  (
    $res->content,
    $res->code. ' ' . $res->message,
    map { $_ => $res->header($_) } $res->header_field_names
  );

  warn $page if $DEBUG;

  my $response;
  my $error;
  if ($server_response =~ /200/){
    $response = XMLin($page);
    if (  exists($response->{Response})
      && !exists($response->{Response}->{Errors})) {     # so much for docs
      $error->{ErrorDescription} = '';
      $error->{ErrorCode} = '';
    }elsif (ref($response->{Response}->{Errors}) eq 'ARRAY') {
      $error = $response->{Response}->{Errors}->[0];
    }else{
      $error = $response->{Response}->{Errors}->{Error};
    }
  }else{
    $error->{ErrorDescription} = "Server Failed";
    $error->{ErrorCode} = $server_response;
  }

  $self->result_code($error->{ErrorCode});
  $self->error_message($error->{ErrorDescription});

  $self->server_response($page);
  $self->response_page($page);
  $self->response_headers(\%headers);
  return $response;
}

sub _xmlwrite {
  my ($self, $writer, $item, $value) = @_;
  $writer->startTag($item);
  if ( ref( $value ) eq 'HASH' ) {
    foreach ( keys ( %$value ) ) {
      $self->_xmlwrite($writer, $_, $value->{$_});
    }
  }else{
    $writer->characters($value);
  }
  $writer->endTag($item);
}

1;
__END__