lib/Business/OnlinePayment/vSecureProcessing.pm

   1 package Business::OnlinePayment::vSecureProcessing;
   2
   3 use strict;
   4 use Carp;
   5 use XML::Writer;
   6 use XML::Simple;
   7 use Data::Dumper;
   8
   9 use Business::OnlinePayment;
  10 use Business::OnlinePayment::HTTPS;
  11 #use Net::SSLeay qw(post_http post_https make_headers make_form);
  12 use vars qw($VERSION $DEBUG @ISA $me);
  13
  14 @ISA = qw(Business::OnlinePayment::HTTPS);
  15 $DEBUG = 0;
  16 $VERSION = '0.01';
  17 $me = 'Business::OnlinePayment::vSecureProcessing';
  18
  19 # mapping out all possible endpoints
  20 # but this version will only be building out "charge", "void", & "credit"
  21 my %payment_actions = (
  22     'charge' => {
  23         path      => '/vsg2/processpayment',
  24         process   => 'ProcessPayment',
  25         fields    => [qw/ Amount Trk1 Trk2 TypeOfSale Cf1 Cf2 Cf AccountNumber ExpirationMonth ExpirationYear Cvv CardHolderFirstName CardHolderLastName AvsZip AvsStreet IndustryType ApplicationId Recurring /]
  26     },
  27     'void' => {
  28         path      => '/vsg2/processvoid',
  29         process   => 'ProcessVoid',
  30         fields    => [qw( Amount AccountNumber ExpirationMonth ExpirationYear ReferenceNumber TransactionDate IndustryType ApplicationId )]
  31     },
  32     'refund' => {
  33         path      => '/vsg2/processrefund',
  34         process   => 'ProcessRefund',
  35         fields    => [qw( Amount AccountNumber ExpirationMonth ExpirationYear ApplicationId )]
  36     },
  37     'authorize' => {
  38         path      => '/vsg2/processauth',
  39     },
  40     'authorize_cancel' => {
  41         path      => '/vsg2/processauthcancel',
  42     },
  43     'capture' => {
  44         path      => '/vsg2/processcaptureonly',
  45     },
  46     'create_token' => {
  47         path      => '/vsg2/createtoken',
  48     },
  49     'delete_token' => {
  50         path      => '/vsg2/deletetoken',
  51     },
  52     'query_token' => {
  53         path      => '/vsg2/querytoken',
  54     },
  55     'update_exp_date' => {
  56         path      => '/vsg2/updateexpiration',
  57     },
  58     'update_token' => {
  59         path      => '/vsg2/updatetoken',
  60     },
  61
  62 );
  63
  64 my %action_mapping = (
  65     'normal authorization'  => 'charge',
  66     'credit'                => 'refund',
  67     'authorization only'    => 'authorize',
  68     'post authorization'    => 'capture',
  69     'reverse authorization' => 'authorize_cancel'
  70     # void => void
  71 );
  72
  73 sub set_defaults {
  74     my $self = shift;
  75     my %options = @_;
  76
  77     # inistialize standard B::OP attributes
  78     $self->is_success(0);
  79     $self->$_( '' ) for qw/authorization
  80                            result_code
  81                            error_message
  82                            server
  83                            port
  84                            path
  85                            server_response/;
  86
  87     # B::OP creates the following accessors:
  88     #     server, port, path, test_transaction, transaction_type,
  89     #     server_response, is_success, authorization,
  90     #     result_code, error_message,
  91
  92     $self->build_subs(qw/
  93             env platform userid gid tid appid action reference_number cvv_response
  94             avs_response risk_score txn_amount txn_date response_code
  95     /);
  96
  97     $DEBUG = exists($options{debug}) ? $options{debug} : $DEBUG;
  98
  99
 100
 101     $self->server($options{'server'});
 102
 103     $self->gid($options{'gid'});
 104
 105     $self->tid($options{'tid'});
 106
 107     $self->platform($options{'platform'});
 108
 109     $self->appid($options{'appid'});
 110
 111     $self->env((defined($options{'env'})) ? $options{'env'} : 'live'); # 'live'/'test'
 112
 113     $self->port(443);
 114 }
 115
 116
 117
 118 sub clean_content {
 119     my ($self,$content) = @_;
 120     my %content = $self->content();
 121
 122     {
 123         no warnings 'uninitialized';
 124
 125         # strip non-digits from card number
 126         my $card_number = '';
 127         if ( $content{card_number} ) {
 128             $content{card_number} =~ s/\D//g;
 129         }
 130
 131         # separate month and year values for expiry_date
 132         if ( $content{expiration} ) {
 133             ($content{exp_month}, $content{exp_year}) = split /\//, $content{expiration};
 134             $content{exp_month} = sprintf "%02d", $content{exp_month};
 135             $content{exp_year}  = substr($content{exp_year},0,2) if ($content{exp_year} > 99);
 136         }
 137
 138         if (!$content{'first_name'} || !$content{'last_name'} && $content{'name'}) {
 139             ($content{'first_name'}, $content{'last_name'}) = split(' ', $content{'name'}, 2);
 140         }
 141
 142         if ($content{'address'} =~ m/[\D ]*(\d+)\D/) {
 143             $content{'street_number'} = $1;
 144         }
 145     }
 146     warn "Content after cleaning:\n".Dumper(\%content)."\n" if ($DEBUG >2);
 147     $self->content(%content);
 148 }
 149
 150 sub process_content {
 151     my $self = shift;
 152     $self->clean_content();
 153     my %content = $self->content();
 154     $self->action(($action_mapping{lc $content{'action'}}) ? $action_mapping{lc $content{'action'}} : lc $content{'action'});
 155     $self->path($payment_actions{ $self->action }{path})
 156       unless length($self->path);
 157     $self->appid($content{appid}) if (!$self->appid && $content{appid});
 158 }
 159
 160 sub submit {
 161     my $self = shift;
 162
 163     # inistialize standard B::OP attributes
 164     $self->is_success(0);
 165     $self->$_( '' ) for qw/authorization
 166                            result_code
 167                            error_message
 168                            server_response/;
 169
 170     # clean and process the $self->content info
 171     $self->process_content();
 172     my %content = $self->content;
 173     my $action = $self->action();
 174
 175     my @acceptable_actions = ('charge', 'refund', 'void');
 176
 177     unless ( grep { $action eq $_ } @acceptable_actions ) {
 178         croak "'$action' is not supported at this time.";
 179     }
 180
 181     # fill in the xml vars
 182     my $xml_vars = {
 183         auth => {
 184             Platform    => $self->platform,
 185             UserId      => $self->userid,
 186             GID         => $self->gid,
 187             Tid         => $self->tid
 188         },
 189
 190         payment => {
 191             Amount          => $content{'amount'},
 192             Trk1            => ($content{'track1'}) ? $content{'track1'} : '',
 193             Trk2            => ($content{'track2'}) ? $content{'track2'} : '',
 194             TypeOfSale      => ($content{'description'}) ? $content{'description'} : '',
 195             Cf1             => ($content{'UDField1'}) ? $content{'UDField1'} : '',
 196             Cf2             => ($content{'UDField2'}) ? $content{'UDField2'} : '',
 197             Cf3             => '',
 198             AccountNumber   => ($content{'card_number'}) ? $content{'card_number'} : '',
 199             ExpirationMonth => $content{'exp_month'},
 200             ExpirationYear  => $content{'exp_year'},
 201             Cvv             => ($content{'cvv'}) ? $content{'cvv'} : ($content{'cvv2'}) ? $content{'cvv2'} : '',
 202             CardHolderFirstName => ($content{'first_name'}) ? $content{'first_name'} : '',
 203             CardHolderLastName => ($content{'last_name'}) ? $content{'last_name'} : '',
 204             AvsZip          => ($content{'zip'}) ? $content{'zip'} : '',
 205             AvsStreet       => ($content{'street_number'}) ? $content{'street_number'} : '',
 206             IndustryType    =>  {
 207                                 IndType => ($content{'IndustryInfo'} && lc($content{'IndustryInfo'}) eq 'ecommerce') ? 'ecom_3' : '',
 208                                 IndInvoice => ($content{'invoice_number'}) ? $content{'invoice_number'} : ''
 209                                 },
 210             ApplicationId   => $self->appid(),
 211             Recurring       => ($content{'recurring_billing'} && $content{'recurring_billing'} eq 'YES' ) ? 1 : 0,
 212             ReferenceNumber => ($content{'ref_num'}) ? $content{'ref_num'} : '',
 213             Token           => ($content{'token'}) ? $content{'token'} : '',
 214             Receipt         => ($content{'receipt'}) ? $content{'receipt'} : '',
 215             TransactionDate => ($content{'txn_date'}) ? $content{'txn_date'} : ''
 216         }
 217         # we won't be using level2 nor level3.  So I'm leaving them out for now.
 218     };
 219
 220     # create the list of required fields based on the action
 221     my @required_fields = qw/ Amount /;
 222     if ($action eq 'charge') {
 223         push(@required_fields, $_) foreach (qw/ AccountNumber Cvv ExpirationMonth ExpirationYear /);
 224     }elsif ($action eq 'void') {
 225         push(@required_fields, $_) foreach (qw/ ReferenceNumber TransactionDate /);
 226     }elsif ($action eq 'refund') {
 227         push(@required_fields, $_) foreach (qw/ Amount AccountNumber ExpirationMonth ExpirationYear /);
 228     }
 229
 230     # check the requirements are met.
 231     my @missing_fields;
 232     foreach my $field (@required_fields) {
 233         push(@missing_fields, $field) if (!$xml_vars->{payment}{$field});
 234     }
 235     if (scalar(@missing_fields)) {
 236         croak "Missing required fields: ".join(', ', @missing_fields);
 237     }
 238
 239     my $process_action = $action;
 240     $process_action =~ s/\b([a-z])/\u$1/g;
 241     $process_action = 'Process'.$process_action;
 242     my $xml_data;
 243     my $writer = new XML::Writer( OUTPUT      => \$xml_data,
 244                                 DATA_MODE   => 0,
 245                                 DATA_INDENT => 0,
 246                                 ENCODING    => 'utf-8',
 247                               );
 248     $writer->xmlDecl();
 249     $writer->startTag('Request');
 250     $writer->startTag('MerchantData');
 251     foreach my $key ( keys ( %{$xml_vars->{auth}} ) ) {
 252         $writer->dataElement( $key, $xml_vars->{auth}{$key} );
 253     }
 254     $writer->endTag('MerchantData');
 255     $writer->startTag($payment_actions{ $self->action }{process});
 256     foreach my $key ( @{$payment_actions{ $self->action }{fields}} ) {
 257         next if (!$xml_vars->{payment}{$key});
 258         if (ref $xml_vars->{payment}{$key} eq '') {
 259             $writer->dataElement( $key, $xml_vars->{payment}{$key});
 260         }else {
 261             $writer->startTag($key);
 262             foreach my $key2 (keys %{$xml_vars->{payment}{$key}}) {
 263                 $writer->dataElement( $key2, $xml_vars->{payment}{$key}{$key2} );
 264             }
 265             $writer->endTag($key);
 266         }
 267     }
 268     $writer->endTag($payment_actions{ $self->action }{process});
 269     $writer->endTag('Request');
 270     $writer->end();
 271
 272     warn "XML:\n$xml_data\n" if $DEBUG > 2;
 273
 274     my $boundary = sprintf('FormBoundary%06d', int(rand(1000000)));
 275     # opts for B:OP:HTTPS::https_post
 276     my $opts = { headers => {}};
 277     $opts->{'Content-Type'} =
 278     $opts->{headers}->{'Content-Type'} =
 279         "multipart/form-data, boundary=$boundary";
 280
 281     my $content =
 282       "--$boundary\n".
 283      "Content-Disposition: form-data; name=\"param\"\n\n".
 284      $xml_data."\n".
 285      "--$boundary--\n";
 286
 287     # conform to RFC standards
 288     $content =~ s/\n/\r\n/gs;
 289
 290     my ( $page, $server_response, %headers ) = $self->https_post( $opts, $content );
 291
 292     # store the server response.
 293     $self->server_response($server_response);
 294     # parse the result page.
 295     $self->parse_response($page);
 296
 297     if (!$self->is_success() && !$self->error_message() ) {
 298         if ( $DEBUG ) {
 299             #additional logging information, possibly too sensitive for an error msg
 300             # (vSecureProcessing seems to have a failure mode where they return the full
 301             #  original request including card number)
 302             $self->error_message(
 303               "(HTTPS response: ".$server_response.") ".
 304               "(HTTPS headers: ".
 305             join(", ", map { "$_ => ". $headers{$_} } keys %headers ). ") ".
 306               "(Raw HTTPS content: ".$page.")"
 307             );
 308         } else {
 309             my $response_code = $self->response_code() || '';
 310             if ($response_code) {
 311                 $self->error_message(qq|Error code ${response_code} was returned by vSecureProcessing. (enable debugging for raw HTTPS response)|);
 312             }else {
 313                 $self->error_message('No error information was returned by vSecureProcessing (enable debugging for raw HTTPS response)');
 314             }
 315         }
 316     }
 317
 318 }
 319
 320 # read $self->server_response and decipher any errors
 321 sub parse_response {
 322     my $self = shift;
 323     my $page = shift;
 324
 325     if ($self->server_response =~ /^200/) {
 326         my $response = XMLin($page);
 327         $self->result_code($response->{Status}); # 0 /1
 328         $self->response_code($response->{ResponseCode}); # see documentation for translation
 329         $self->avs_response($response->{AvsResponse}); # Y / N
 330         $self->cvv_response($response->{CvvResponse}); # P / F
 331         $self->txn_date($response->{TransactionDate}); # MMDDhhmmss
 332         $self->txn_amount($response->{TransactionAmount} / 100); # 00000003500 / 100
 333         $self->reference_number($response->{ReferenceNumber});
 334
 335         $self->is_success($self->result_code() eq '0' ? 1 : 0);
 336         if ($self->is_success()) {
 337             $self->authorization($response->{AuthIdentificationResponse});
 338         }
 339         # fill in error_message if there is is an error
 340         if ( !$self->is_success && exists($response->{AdditionalResponseData})) {
 341             $self->error_message('Error '.$response->{ResponseCode}.': '.$response->{AdditionalResponseData});
 342         }elsif ( !$self->is_success && exists($response->{Receipt}) ) {
 343             $self->error_message('Error '.$response->{ResponseCode}.': '.(exists($response->{Receipt})) ? $response->{Receipt} : '');
 344         }
 345
 346     }else {
 347         $self->is_success(0);
 348         $self->error_message('Error communicating with vSecureProcessing server');
 349         return;
 350     }
 351
 352 }
 353
 354 1;
 355 __END__
 356
 357
 358 =head1 NAME
 359
 360 Business::OnlinePayment::vSecureProcessing - vSecureProcessing backend for Business::OnlinePayment
 361
 362 =head1 SYNOPSIS
 363
 364   use Business::OnlinePayment;
 365   my %processor_info = (
 366     platform    => '####',
 367     gid         => 12345678901234567890,
 368     tid         => 01,
 369     user_id     => '####',
 370     url         => 'www.####.com'
 371   );
 372   my $tx =
 373     new Business::OnlinePayment( "vSecureProcessing", %processor_info);
 374   $tx->content(
 375       appid          => '######',
 376       type           => 'VISA',
 377       action         => 'Normal Authorization',
 378       description    => 'Business::OnlinePayment test',
 379       amount         => '49.95',
 380       customer_id    => 'tfb',
 381       name           => 'Tofu Beast',
 382       address        => '123 Anystreet',
 383       city           => 'Anywhere',
 384       state          => 'UT',
 385       zip            => '84058',
 386       card_number    => '4007000000027',
 387       expiration     => '09/02',
 388       cvv2           => '1234', #optional
 389   );
 390   $tx->submit();
 391
 392   if($tx->is_success()) {
 393       print "Card processed successfully: ".$tx->authorization."\n";
 394   } else {
 395       print "Card was rejected: ".$tx->error_message."\n";
 396   }
 397
 398 =head1 DESCRIPTION
 399
 400 For detailed information see L<Business::OnlinePayment>.
 401
 402 =head1 METHODS AND FUNCTIONS
 403
 404 See L<Business::OnlinePayment> for the complete list. The following methods either override the methods in L<Business::OnlinePayment> or provide additional functions.
 405
 406 =head2 result_code
 407
 408 Returns the response error code.
 409
 410 =head2 error_message
 411
 412 Returns the response error description text.
 413
 414 =head2 server_response
 415
 416 Returns the complete response from the server.
 417
 418 =head1 Handling of content(%content) data:
 419
 420 =head2 action
 421
 422 The following actions are valid
 423
 424   normal authorization
 425   credit
 426   void
 427
 428 =head1 Setting vSecureProcessing parameters from content(%content)
 429
 430 The following rules are applied to map data to vSecureProcessing parameters
 431 from content(%content):
 432
 433       # param => $content{<key>}
 434       AccountNumber       => 'card_number',
 435       Cvv                 => 'cvv2',
 436       ExpirationMonth     => \( $month ), # MM from MM/YY of 'expiration'
 437       ExpirationYear      => \( $year ), # YY from MM/YY of 'expiration'
 438       Trk1                => 'track1',
 439       Trk2                => 'track2',
 440       CardHolderFirstName => 'first_name',
 441       CardHolderLastName  => 'last_name',
 442       Amount              => 'amount'
 443       AvsStreet           => 'address',
 444       AvsZip              => 'zip',
 445       Cf1                 => 'UDField1',
 446       Cf2                 => 'UDField2',
 447       IndustryType        => 'IndustryInfo',
 448
 449 =head1 NOTE
 450
 451 =head1 COMPATIBILITY
 452
 453 Business::OnlinePayment::vSecureProcessing uses vSecureProcessing XML Document Version: 140901 (September 1, 2014).
 454
 455 See http://www.vsecureprocessing.com/ for more information.
 456
 457 =head1 AUTHORS
 458
 459 Original author: Alex Brelsfoard
 460
 461 Current maintainer: Alex Brelsfoard
 462
 463 =head1 COPYRIGHT
 464
 465 Copyright (c) 2015 Freeside Internet Services, Inc.
 466
 467 All rights reserved.
 468
 469 This program is free software; you can redistribute it and/or modify it under
 470 the same terms as Perl itself.
 471
 472 =head1 ADVERTISEMENT
 473
 474 Need a complete, open-source back-office and customer self-service solution?
 475 The Freeside software includes support for credit card and electronic check
 476 processing with vSecureProcessing and over 50 other gateways, invoicing, integrated
 477 trouble ticketing, and customer signup and self-service web interfaces.
 478
 479 http://freeside.biz/freeside/
 480
 481 =head1 SEE ALSO
 482
 483 perl(1). L<Business::OnlinePayment>.
 484
 485 =cut
 486
 487