Vanco.pm

   1 package Business::OnlinePayment::Vanco;
   2
   3 use strict;
   4 use Carp;
   5 use Tie::IxHash;
   6 use XML::Simple;
   7 use XML::Writer;
   8 use LWP::UserAgent;
   9 use HTTP::Request;
  10 use HTTP::Request::Common qw (POST);
  11 use Date::Calc qw(Add_Delta_YM Add_Delta_Days);
  12 use Business::OnlinePayment;
  13 #use Business::OnlinePayment::HTTPS;
  14 use vars qw($VERSION $DEBUG @ISA $me);
  15
  16 @ISA = qw(Business::OnlinePayment);  # Business::OnlinePayment::HTTPS
  17 $VERSION = '0.01';
  18 $DEBUG = 1;
  19 $me = 'Business::OnlinePayment::Vanco';
  20
  21 sub set_defaults {
  22     my $self = shift;
  23     my %opts = @_;
  24
  25     # standard B::OP methods/data
  26     $self->server('www.vancoservices.com') unless $self->server;
  27     $self->port('443') unless $self->port;
  28     $self->path('/cgi-bin/ws.vps') unless $self->path;
  29
  30     $self->build_subs(qw( order_number avs_code cvv2_response
  31                           response_page response_code response_headers
  32                      ));
  33
  34     # module specific data
  35     foreach (qw( ClientID ProductID )) {
  36       $self->build_subs($_);
  37
  38       if ( $opts{$_} ) {
  39           $self->$_( $opts{$_} );
  40           delete $opts{$_};
  41       }
  42     }
  43
  44 }
  45
  46 sub map_fields {
  47     my($self) = @_;
  48
  49     my %content = $self->content();
  50     my $action = lc($content{'action'});
  51
  52     # ACTION MAP
  53     my %actions =
  54       ( 'normal authorization'            => 'EFTAddCompleteTransaction',
  55         'recurring authorization'         => 'EFTAddCompleteTransaction',
  56         'cancel recurring authorization'  => 'EFTDeleteTransaction',
  57       );
  58     $content{'RequestType'} = $actions{$action} || $action;
  59
  60     # TYPE MAP
  61     my %types = ( 'visa'               => 'CC',
  62                   'mastercard'         => 'CC',
  63                   'american express'   => 'CC',
  64                   'discover'           => 'CC',
  65                   'check'              => 'ECHECK',
  66                 );
  67     $content{'type'} = $types{lc($content{'type'})} || $content{'type'};
  68     $self->transaction_type($content{'type'});
  69
  70     # CHECK/TRANSACTION TYPE MAP
  71     $content{'TransactionTypeCode'} = $content{'check_type'} || 'PPD'
  72       unless ( $content{'TransactionTypeCode'}
  73             || $content{'RequestType'} eq 'EFTDeleteTransaction'); # kludgy
  74
  75     # let FrequencyCode, StartDate, and EndDate be specified directly;
  76     unless($content{FrequencyCode}){
  77       my ($length,$unit) =
  78         ($self->{_content}->{interval} or '') =~
  79           /^\s*(\d+)\s+(day|month)s?\s*$/;
  80
  81       my %daily   = (  '7' => 'W',
  82                       '14' => 'BW',
  83                     );
  84
  85       my %monthly = (  '1' => 'M',
  86                        '3' => 'Q',
  87                       '12' => 'A',
  88                     );
  89
  90       if ($length && $unit) {
  91         $content{'FrequencyCode'} = $daily{$length}
  92           if ($unit eq 'day');
  93
  94         $content{'FrequencyCode'} = $monthly{$length}
  95           if ($unit eq 'month');
  96       }
  97     }
  98
  99     unless($content{StartDate}){
 100       $content{'StartDate'} = $content{'start'};
 101     }
 102
 103     unless($content{EndDate}){
 104       my ($year,$month,$day) =
 105         $content{StartDate} =~ /^\s*(\d{4})-(\d{1,2})-(\d{1,2})\s*$/
 106         if $content{StartDate};
 107
 108       my ($periods) = $content{periods} =~/^\s*(\d+)\s*$/
 109         if $content{periods};
 110
 111       my %daily   = (  'W' => '7',
 112                       'BW' => '14',
 113                     );
 114
 115       my %monthly = (  'M' => '1',
 116                        'Q' => '3',
 117                        'A' => '12',
 118                     );
 119
 120       if ($year && $month && $day && $periods) {
 121         if ($daily{$content{FrequencyCode}}) {
 122           my $days = ($periods - 1) * $daily{$content{FrequencyCode}};
 123           ($year, $month, $day) = Add_Delta_Days( $year, $month, $day, $days);
 124           $content{EndDate} = sprintf("%04d-%02d-%02d", $year, $month, $day);
 125         }
 126
 127         if ($monthly{$content{FrequencyCode}}) {
 128           my $months = ($periods - 1) * $monthly{$content{FrequencyCode}};
 129           ($year, $month, $day) = Add_Delta_YM( $year, $month, $day, 0, $months);
 130           $content{EndDate} = sprintf("%04d-%02d-%02d", $year, $month, $day);
 131         }
 132       }
 133
 134     }
 135
 136     if ($action eq 'normal authorization'){
 137       my $time = time + 86400 if $self->transaction_type() eq 'ECHECK';
 138       $content{'FrequencyCode'} = 'O';
 139       $content{'StartDate'} = $content{'start'} || substr(today($time),0,10);
 140       $content{'EndDate'} = $content{'StartDate'};
 141     }
 142
 143
 144     # ACCOUNT TYPE MAP
 145     my %account_types = ('personal checking'   => 'C',
 146                          'personal savings'    => 'S',
 147                          'business checking'   => 'C',
 148                          'business savings'    => 'S',
 149                          'checking'            => 'C',
 150                          'savings'             => 'S',
 151                         );
 152     $content{'account_type'} = $account_types{lc($content{'account_type'})}
 153                                || $content{'account_type'};
 154     $content{'account_type'} = 'CC' if lc($content{'type'}) eq 'cc';
 155
 156     # SHIPPING INFORMATION
 157     foreach (qw(name address city state zip)) {
 158       $content{"ship_$_"} = $content{$_} unless $content{"ship$_"};
 159     }
 160
 161     # stuff it back into %content
 162     $self->content(%content);
 163
 164 }
 165
 166 sub expdate_month {
 167   my ($self, $exp) = (shift, shift);
 168   my $month;
 169   if ( defined($exp) and $exp =~ /^(\d+)\D+\d*\d{2}$/ ) {
 170     $month  = sprintf( "%02d", $1 );
 171   }elsif ( defined($exp) and $exp =~ /^(\d{2})\d{2}$/ ) {
 172     $month  = sprintf( "%02d", $1 );
 173   }
 174   return $month;
 175 }
 176
 177 sub expdate_year {
 178   my ($self, $exp) = (shift, shift);
 179   my $year;
 180   if ( defined($exp) and $exp =~ /^\d+\D+\d*(\d{2})$/ ) {
 181     $year  = sprintf( "%02d", $1 );
 182   }elsif ( defined($exp) and $exp =~ /^\d{2}(\d{2})$/ ) {
 183     $year  = sprintf( "%02d", $1 );
 184   }
 185   return $year;
 186 }
 187
 188 sub today {
 189   my @time = localtime($_[0] ? shift : time);
 190   $time[5] += 1900;
 191   $time[4]++;
 192   sprintf("%04d-%02d-%02d %02d:%02d:%02d", reverse(@time[0..5]));
 193 }
 194
 195 sub revmap_fields {
 196   my $self = shift;
 197   tie my(%map), 'Tie::IxHash', @_;
 198   my %content = $self->content();
 199   map {
 200         my $value;
 201         if ( ref( $map{$_} ) eq 'HASH' ) {
 202           $value = $map{$_} if ( keys %{ $map{$_} } );
 203         }elsif( ref( $map{$_} ) ) {
 204           $value = ${ $map{$_} };
 205         }elsif( exists( $content{ $map{$_} } ) ) {
 206           $value = $content{ $map{$_} };
 207         }
 208
 209         if (defined($value)) {
 210           ($_ => $value);
 211         }else{
 212           ();
 213         }
 214       } (keys %map);
 215 }
 216
 217 sub submit {
 218   my($self) = @_;
 219
 220   $self->is_success(0);
 221   unless($self->ClientID() && $self->ProductID()) {
 222     croak "ClientID and ProductID are required";
 223   }
 224
 225   my $requestid = time . sprintf("%010u", rand() * 2**32);
 226   my $auth_requestid = $requestid . '0';
 227   my $req_requestid  = $requestid . '1';
 228
 229   $self->map_fields();
 230
 231   my @required_fields = qw(action login password);
 232
 233   if ( lc($self->{_content}->{action}) eq 'normal authorization' ) {
 234     push @required_fields, qw( type amount name );
 235
 236     push @required_fields, qw( card_number expiration )
 237       if ($self->transaction_type() eq "CC");
 238
 239     push @required_fields,
 240       qw( routing_code account_number account_type )
 241       if ($self->transaction_type() eq "ECHECK");
 242
 243   }elsif ( lc($self->{_content}->{action}) eq 'recurring authorization' ) {
 244     push @required_fields, qw( type interval start periods amount name );
 245
 246     push @required_fields, qw( card_number expiration )
 247       if ($self->transaction_type() eq 'CC' );
 248
 249     push @required_fields,
 250       qw( routing_code account_number account_type )
 251       if ($self->transaction_type() eq "ECHECK");
 252
 253   }elsif ( lc($self->{_content}->{action}) eq 'cancel recurring authorization' ) {
 254     push @required_fields, qw( subscription );
 255
 256   }else{
 257     croak "$me can't handle transaction type: ".
 258       $self->{_content}->{action}. " for ".
 259       $self->transaction_type();
 260   }
 261
 262   $self->required_fields(@required_fields);
 263
 264   tie my %auth, 'Tie::IxHash', (
 265                                  RequestType => 'Login',
 266                                  RequestID   => $auth_requestid,
 267                                  RequestTime => today(),
 268                                );
 269
 270   tie my %requestvars, 'Tie::IxHash',
 271     $self->revmap_fields(
 272                           UserID      => 'login',
 273                           Password    => 'password',
 274                         );
 275   $requestvars{'ProductID'} = $self->ProductID();
 276
 277   tie my %req, 'Tie::IxHash',
 278     $self->revmap_fields (
 279                            Auth    => \%auth,
 280                            Request => { RequestVars => \%requestvars },
 281                          );
 282
 283   my $response = $self->_my_https_post(%req);
 284   return if $self->result_code();
 285
 286   tie %auth, 'Tie::IxHash',
 287     $self->revmap_fields( RequestType => 'RequestType');
 288   $auth{'RequestID'}   = $req_requestid;
 289   $auth{'RequestTime'} = today();
 290   $auth{'SessionID'}   = $response->{Response}->{SessionID};
 291
 292   my $client_id = $self->ClientID();
 293   my $cardexpmonth = $self->expdate_month($self->{_content}->{expiration});
 294   my $cardexpyear  = $self->expdate_year($self->{_content}->{expiration});
 295   my $account_number = ( defined($self->transaction_type())
 296                          && $self->transaction_type() eq 'CC')
 297                        ? $self->{_content}->{card_number}
 298                        : $self->{_content}->{account_number}
 299   ;
 300
 301   tie %requestvars, 'Tie::IxHash',
 302     $self->revmap_fields(
 303                           ClientID            => \$client_id,
 304                           CustomerID          => 'customer_id',
 305                           CustomerName        => 'ship_name',   # defaults to
 306                           CustomerAddress1    => 'ship_address',# values without
 307                           CustomerCity        => 'ship_city',   # ship_ prefix
 308                           CustomerState       => 'ship_state',  #
 309                           CustomerZip         => 'ship_zip',    #
 310                           CustomerPhone       => 'phone',
 311                           AccountType         => 'account_type',
 312                           AccountNumber       => \$account_number,
 313                           RoutingNumber       => 'routing_code',
 314                           CardBillingName     => 'name',
 315                           CardExpMonth        => \$cardexpmonth,
 316                           CardExpYear         => \$cardexpyear,
 317                           CardCVV2            => 'cvv2',
 318                           CardBillingAddr1    => 'address',
 319                           CardBillingCity     => 'city',
 320                           CardBillingState    => 'state',
 321                           CardBillingZip      => 'zip',
 322                           Amount              => 'amount',
 323                           StartDate           => 'StartDate',
 324                           EndDate             => 'EndDate',
 325                           FrequencyCode       => 'FrequencyCode',
 326                           TransactionTypeCode => 'TransactionTypeCode',
 327                           TransactionRef      => 'subscription',
 328                         );
 329
 330   tie %req, 'Tie::IxHash',
 331     $self->revmap_fields (
 332                            Auth    => \%auth,
 333                            Request => { RequestVars => \%requestvars },
 334                          );
 335
 336   $response = $self->_my_https_post(%req);
 337   $self->order_number($response->{Response}->{TransactionRef});
 338
 339   $self->is_success(1);
 340   if ($self->result_code()) {
 341     $self->is_success(0);
 342     unless ( $self->error_message() ) { #additional logging information
 343       my %headers = %{$self->response_headers()};
 344       $self->error_message(
 345         "(HTTPS response: ". $self->result_code(). ") ".
 346         "(HTTPS headers: ".
 347           join(", ", map { "$_ => ". $headers{$_} } keys %headers ). ") ".
 348         "(Raw HTTPS content: ". $self->server_response(). ")"
 349       );
 350     }
 351   }
 352
 353 }
 354
 355 sub _my_https_post {
 356   my $self = shift;
 357   my %req = @_;
 358   my $post_data;
 359   my $writer = new XML::Writer( OUTPUT      => \$post_data,
 360                                 DATA_MODE   => 1,
 361                                 DATA_INDENT => 1,
 362 #                                ENCODING    => 'us-ascii',
 363                               );
 364   $writer->xmlDecl();
 365   $writer->startTag('VancoWS');
 366   foreach ( keys ( %req ) ) {
 367     $self->_xmlwrite($writer, $_, $req{$_});
 368   }
 369   $writer->endTag('VancoWS');
 370   $writer->end();
 371
 372   if ($self->test_transaction()) {
 373     $self->server('www.vancodev.com');
 374     $self->port('443');
 375     $self->path('/cgi-bin/wstest.vps');
 376   }
 377
 378   my $url = "https://" . $self->server. ':';
 379   $url .= $self->port || '443';
 380   $url .= $self->path;
 381
 382   my $ua = new LWP::UserAgent;
 383   my $res = $ua->request( POST( $url, 'Content_Type' => 'form-data',
 384                                       'Content' => [ 'xml' => $post_data ])
 385                         );
 386
 387   warn $post_data if $DEBUG;
 388   my($page,$server_response,%headers) =  (
 389     $res->content,
 390     $res->code. ' ' . $res->message,
 391     map { $_ => $res->header($_) } $res->header_field_names
 392   );
 393
 394   warn $page if $DEBUG;
 395
 396   my $response;
 397   my $error;
 398   if ($server_response =~ /200/){
 399     $response = XMLin($page);
 400     if (  exists($response->{Response})
 401       && !exists($response->{Response}->{Errors})) {     # so much for docs
 402       $error->{ErrorDescription} = '';
 403       $error->{ErrorCode} = '';
 404     }elsif (ref($response->{Response}->{Errors}) eq 'ARRAY') {
 405       $error = $response->{Response}->{Errors}->[0];
 406     }else{
 407       $error = $response->{Response}->{Errors}->{Error};
 408     }
 409   }else{
 410     $error->{ErrorDescription} = "Server Failed";
 411     $error->{ErrorCode} = $server_response;
 412   }
 413
 414   $self->result_code($error->{ErrorCode});
 415   $self->error_message($error->{ErrorDescription});
 416
 417   $self->server_response($page);
 418   $self->response_page($page);
 419   $self->response_headers(\%headers);
 420   return $response;
 421 }
 422
 423 sub _xmlwrite {
 424   my ($self, $writer, $item, $value) = @_;
 425   $writer->startTag($item);
 426   if ( ref( $value ) eq 'HASH' ) {
 427     foreach ( keys ( %$value ) ) {
 428       $self->_xmlwrite($writer, $_, $value->{$_});
 429     }
 430   }else{
 431     $writer->characters($value);
 432   }
 433   $writer->endTag($item);
 434 }
 435
 436 1;
 437 __END__
 438
 439 =head1 NAME
 440
 441 Business::OnlinePayment::Vanco - Vanco Services backend for Business::OnlinePayment
 442
 443 =head1 SYNOPSIS
 444
 445   use Business::OnlinePayment;
 446
 447   ####
 448   # One step transaction, the simple case.
 449   ####
 450
 451   my $tx = new Business::OnlinePayment( "Vanco",
 452                                         ClientID  => 'CL1234',
 453                                         ProductID => 'EFT',
 454                                       );
 455   $tx->content(
 456       type           => 'VISA',
 457       login          => 'testdrive',
 458       password       => '', #password
 459       action         => 'Normal Authorization',
 460       description    => 'Business::OnlinePayment test',
 461       amount         => '49.95',
 462       customer_id    => 'tfb',
 463       name           => 'Tofu Beast',
 464       address        => '123 Anystreet',
 465       city           => 'Anywhere',
 466       state          => 'UT',
 467       zip            => '84058',
 468       card_number    => '4007000000027',
 469       expiration     => '09/02',
 470       cvv2           => '1234', #optional
 471   );
 472   $tx->submit();
 473
 474   if($tx->is_success()) {
 475       print "Card processed successfully: ".$tx->authorization."\n";
 476   } else {
 477       print "Card was rejected: ".$tx->error_message."\n";
 478   }
 479
 480   ####
 481   # One step subscription, the simple case.
 482   ####
 483
 484   my $tx = new Business::OnlinePayment( "Vanco",
 485                                         ClientID  => 'CL1234',
 486                                         ProductID => 'EFT',
 487                                       );
 488   $tx->content(
 489       type           => 'CC',
 490       login          => 'testdrive',
 491       password       => 'testpass',
 492       action         => 'Recurring Authorization',
 493       interval       => '7 days',
 494       start          => '2008-3-10',
 495       periods        => '16',
 496       amount         => '99.95',
 497       description    => 'Business::OnlinePayment test',
 498       customer_id    => 'vip',
 499       name           => 'Tofu Beast',
 500       address        => '123 Anystreet',
 501       city           => 'Anywhere',
 502       state          => 'GA',
 503       zip            => '84058',
 504       card_number    => '4111111111111111',
 505       expiration     => '09/02',
 506   );
 507   $tx->submit();
 508
 509   if($tx->is_success()) {
 510       print "Card processed successfully: ".$tx->order_number."\n";
 511   } else {
 512       print "Card was rejected: ".$tx->error_message."\n";
 513   }
 514   my $subscription = $tx->order_number
 515
 516
 517   ####
 518   # Subscription cancellation.   It happens.
 519   ####
 520
 521   $tx->content(
 522       subscription   => '99W2D',
 523       login          => 'testdrive',
 524       password       => 'testpass',
 525       action         => 'Cancel Recurring Authorization',
 526   );
 527   $tx->submit();
 528
 529   if($tx->is_success()) {
 530       print "Cancellation processed successfully."\n";
 531   } else {
 532       print "Cancellation was rejected: ".$tx->error_message."\n";
 533   }
 534
 535
 536 =head1 SUPPORTED TRANSACTION TYPES
 537
 538 =head2 CC, Visa, MasterCard, American Express, Discover
 539
 540 Content required: type, login, password, action, amount, name, card_number, expiration.
 541
 542 =head2 Check
 543
 544 Content required: type, login, password, action, amount, name, account_number, routing_code, account_type.
 545
 546 =head2 Subscriptions
 547
 548 Additional content required: interval, start, periods.
 549
 550 =head1 DESCRIPTION
 551
 552 For detailed information see L<Business::OnlinePayment>.
 553
 554 =head1 METHODS AND FUNCTIONS
 555
 556 See L<Business::OnlinePayment> for the complete list. The following methods either override the methods in L<Business::OnlinePayment> or provide additional functions.
 557
 558 =head2 result_code
 559
 560 Returns the response error code.
 561
 562 =head2 error_message
 563
 564 Returns the response error description text.
 565
 566 =head2 server_response
 567
 568 Returns the complete response from the server.
 569
 570 =head1 Handling of content(%content) data:
 571
 572 =head2 action
 573
 574 The following actions are valid
 575
 576   normal authorization
 577   recurring authorization
 578   cancel recurring authorization
 579
 580 =head2 interval
 581
 582   Interval contains a number of digits, whitespace, and the units of days or months in either singular or plural form.
 583
 584 =head1 Setting Vanco parameters from content(%content)
 585
 586 The following rules are applied to map data to AuthorizeNet ARB parameters
 587 from content(%content):
 588
 589       # param => $content{<key>}
 590       Auth
 591         UserId                   =>  'login',
 592         Password                 =>  'password',
 593       Request
 594         RequestVars
 595           CustomerID             => 'customer_id',
 596           CustomerName           => 'ship_name',
 597           CustomerAddress1       => 'ship_address',
 598           CustomerCity           => 'ship_city',
 599           CustomerState          => 'ship_state',
 600           CustomerZip            => 'ship_zip',
 601           CustomerPhone          => 'phone',
 602           AccountType            => 'account_type',  # C, S, or CC
 603           AccountNumber          => 'account_number' # or card_number
 604           RoutingNumber          => 'routing_code',
 605           CardBillingName        => 'name',
 606           CardExpMonth           => \( $month ), # YYYY-MM from 'expiration'
 607           CardExpYear            => \( $year ), # YYYY-MM from 'expiration'
 608           CardCVV2               => 'cvv2',
 609           CardBillingAddr1       => 'address',
 610           CardBillingCity        => 'city',
 611           CardBillingState       => 'state',
 612           CardBillingZip         => 'zip',
 613           Amount                 => 'amount',
 614           StartDate              => 'start',
 615           EndDate                => calculated_from start, periods, interval,
 616           FrequencyCode          => [O,M,W,BW,Q, or A determined from interval],
 617           TransactionTypeCode    => 'check_type', # (or PPD by default)
 618
 619 =head1 NOTE
 620
 621 To cancel a recurring authorization transaction, submit the TransactionRef
 622 in the field "subscription" with the action set to "Cancel Recurring
 623 Authorization".  You can get the TransactionRef from the authorization by
 624 calling the order_number method on the object returned from the authorization.
 625
 626 =head1 COMPATIBILITY
 627
 628 Business::OnlinePayment::Vanco uses Vanco Services' "Standard Web Services
 629 XML API"  as described on February 29, 2008.  The describing documents
 630 are protected by a non-disclosure agreement.
 631
 632 See http://www.vancoservices.com/ for more information.
 633
 634 =head1 AUTHOR
 635
 636 Jeff Finucane, vanco@weasellips.com
 637
 638 =head1 SEE ALSO
 639
 640 perl(1). L<Business::OnlinePayment>.
 641
 642 =cut
 643