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