InternetSecure.pm

   1 package Business::OnlinePayment::InternetSecure;
   2
   3 use 5.008;
   4 use strict;
   5 use warnings;
   6
   7 use Carp;
   8 use Encode;
   9 use Net::SSLeay qw(make_form post_https);
  10 use XML::Simple qw(xml_in xml_out);
  11
  12 use base qw(Business::OnlinePayment Exporter);
  13
  14
  15 our $VERSION = '0.01';
  16
  17
  18 use constant SUCCESS_CODES => qw(2000 90000 900P1);
  19
  20 use constant CARD_TYPES => {
  21                                 VI => 'Visa',
  22                                 MC => 'MasterCard',
  23                                 AX => 'American Express', # FIXME: AM?
  24                                 NN => 'Discover',
  25                                 # JB?
  26                         };
  27
  28
  29 # Convenience functions to avoid undefs and escape products strings
  30 sub _def($) { defined $_[0] ? $_[0] : '' }
  31 sub _esc($) { local $_ = shift; tr/|:/ /s; tr/"`/'/s; return $_ }
  32
  33
  34 sub set_defaults {
  35         my ($self) = @_;
  36
  37         $self->server('secure.internetsecure.com');
  38         $self->port(443);
  39         $self->path('/process.cgi');
  40
  41         $self->build_subs(qw(
  42                                 receipt_number  sales_number    uuid    guid
  43                                 date
  44                                 card_type       cardholder
  45                                 total_amount    tax_amounts
  46                                 avs_response    cvv2_response
  47                         ));
  48
  49         # Just in case someone tries to call tax_amounts() *before* submit()
  50         $self->tax_amounts( {} );
  51 }
  52
  53 # OnlinePayment's get_fields now filters out undefs in 3.x. :(
  54 #
  55 sub get_fields {
  56         my ($self, @fields) = @_;
  57
  58         my %content = $self->content;
  59
  60         my %new = map +($_ => $content{$_}), @fields;
  61
  62         return %new;
  63 }
  64
  65 # Combine get_fields and remap_fields for convenience
  66 #
  67 sub get_remap_fields {
  68         my ($self, %map) = @_;
  69
  70         $self->remap_fields(reverse %map);
  71         my %data = $self->get_fields(keys %map);
  72
  73         return %data;
  74 }
  75
  76 # Since there's no standard format for expiration dates, we try to do our best
  77 #
  78 sub parse_expdate {
  79         my ($self, $str) = @_;
  80
  81         local $_ = $str;
  82
  83         my ($y, $m);
  84
  85         if (/^(\d{4})\W(\d{1,2})$/ ||           # YYYY.MM  or  YYYY-M
  86                         /^(\d\d)\W(\d)$/ ||     # YY/M  or  YY-M
  87                         /^(\d\d)[.-](\d\d)$/) { # YY-MM
  88                 ($y, $m) = ($1, $2);
  89         } elsif (/^(\d{1,2})\W(\d{4})$/ ||      # MM-YYYY  or  M/YYYY
  90                         /^(\d)\W(\d\d)$/ ||     # M/YY  or  M-YY
  91                         /^(\d\d)\/?(\d\d)$/) {  # MM/YY  or  MMYY
  92                 ($y, $m) = ($2, $1);
  93         } else {
  94                 croak "Unable to parse expiration date: $str";
  95         }
  96
  97         $y += 2000 if $y < 2000;  # Aren't we glad Y2K is behind us?
  98
  99         return ($y, $m);
 100 }
 101
 102 # Convert a single product into a product string
 103 #
 104 sub prod_string {
 105         my ($self, $currency, %data) = @_;
 106
 107         croak "Missing amount in product" unless defined $data{amount};
 108
 109         my @flags = ($currency);
 110
 111         my @taxes;
 112         if (ref $data{taxes}) {
 113                 @taxes = @{ $data{taxes} };
 114         } elsif ($data{taxes}) {
 115                 @taxes = split ' ' => $data{taxes};
 116         }
 117
 118         foreach (@taxes) {
 119                 croak "Unknown tax code $_" unless /^(GST|PST|HST)$/i;
 120                 push @flags, uc $_;
 121         }
 122
 123         if ($self->test_transaction) {
 124                 push @flags, $self->test_transaction < 0 ? 'TESTD' : 'TEST';
 125         }
 126
 127         return join '::' =>
 128                                 sprintf('%.2f' => $data{amount}),
 129                                 $data{quantity} || 1,
 130                                 _esc _def $data{sku},
 131                                 _esc _def $data{description},
 132                                 join('' => map "{$_}" => @flags),
 133                                 ;
 134 }
 135
 136 # Generate the XML document for this transaction
 137 #
 138 sub to_xml {
 139         my ($self) = @_;
 140
 141         my %content = $self->content;
 142
 143         $self->required_fields(qw(action card_number exp_date));
 144
 145         croak 'Unsupported transaction type'
 146                 if $content{type} && $content{type} !~
 147                         /^(Visa|MasterCard|American Express|Discover)$/i;
 148
 149         croak 'Unsupported action'
 150                 unless $content{action} =~ /^Normal Authori[zs]ation$/i;
 151
 152         $content{currency} = uc($content{currency} || 'CAD');
 153         croak "Unknown currency code ", $content{currency}
 154                 unless $content{currency} =~ /^(CAD|USD)$/;
 155
 156         my %data = $self->get_remap_fields(qw(
 157                         xxxCard_Number          card_number
 158
 159                         xxxName                 name
 160                         xxxCompany              company
 161                         xxxAddress              address
 162                         xxxCity                 city
 163                         xxxProvince             state
 164                         xxxPostal               zip
 165                         xxxCountry              country
 166                         xxxPhone                phone
 167                         xxxEmail                email
 168
 169                         xxxShippingName         ship_name
 170                         xxxShippingCompany      ship_company
 171                         xxxShippingAddress      ship_address
 172                         xxxShippingCity         ship_city
 173                         xxxShippingProvince     ship_state
 174                         xxxShippingPostal       ship_zip
 175                         xxxShippingCountry      ship_country
 176                         xxxShippingPhone        ship_phone
 177                         xxxShippingEmail        ship_email
 178                 ));
 179
 180         $data{MerchantNumber} = $self->merchant_id;
 181
 182         $data{xxxCard_Number} =~ tr/- //d;
 183         $data{xxxCard_Number} =~ s/^[^3-6]/4/ if $self->test_transaction;
 184
 185         my ($y, $m) = $self->parse_expdate($content{exp_date});
 186         $data{xxxCCYear} = sprintf '%.4u' => $y;
 187         $data{xxxCCMonth} = sprintf '%.2u' => $m;
 188
 189         if (defined $content{cvv2} && $content{cvv2} ne '') {
 190                 $data{CVV2} = 1;
 191                 $data{CVV2Indicator} = $content{cvv2};
 192         } else {
 193                 $data{CVV2} = 0;
 194                 $data{CVV2Indicator} = '';
 195         }
 196
 197         if (ref $content{description}) {
 198                 $data{Products} = join '|' => map $self->prod_string(
 199                                                 $content{currency},
 200                                                 taxes => $content{taxes},
 201                                                 %$_),
 202                                         @{ $content{description} };
 203         } else {
 204                 $self->required_fields(qw(amount));
 205                 $data{Products} = $self->prod_string(
 206                                         $content{currency},
 207                                         taxes       => $content{taxes},
 208                                         amount      => $content{amount},
 209                                         description => $content{description},
 210                                 );
 211         }
 212
 213         xml_out(\%data,
 214                 NoAttr          => 1,
 215                 NumericEscape   => 2,
 216                 RootName        => 'TranxRequest',
 217                 SuppressEmpty   => undef,
 218                 XMLDecl         => '<?xml version="1.0" encoding="iso-8859-1" standalone="yes"?>',
 219         );
 220 }
 221
 222 # Map the various fields from the response, and put their values into our
 223 # object for retrieval.
 224 #
 225 sub infuse {
 226         my ($self, $data, %map) = @_;
 227
 228         while (my ($k, $v) = each %map) {
 229                 no strict 'refs';
 230                 $self->$k($data->{$v});
 231         }
 232 }
 233
 234 sub extract_tax_amounts {
 235         my ($self, $response) = @_;
 236
 237         my %tax_amounts;
 238
 239         my $products = $response->{Products};
 240         return unless $products;
 241
 242         foreach my $node (@$products) {
 243                 my $flags = $node->{flags};
 244                 if ($flags &&
 245                         grep($_ eq '{TAX}', @$flags) &&
 246                         grep($_ eq '{CALCULATED}', @$flags))
 247                 {
 248                         $tax_amounts{ $node->{code} } = $node->{subtotal};
 249                 }
 250         }
 251
 252         return %tax_amounts;
 253 }
 254
 255 # Parse the server's response and set various fields
 256 #
 257 sub parse_response {
 258         my ($self, $response) = @_;
 259
 260         $self->server_response($response);
 261
 262         local $/ = "\n";  # Make sure to avoid bug #17687
 263
 264         $response = xml_in($response,
 265                         ForceArray => [qw(product flag)],
 266                         GroupTags => { qw(Products product flags flag) },
 267                         KeyAttr => [],
 268                         SuppressEmpty => undef,
 269                 );
 270
 271         $self->infuse($response,
 272                         result_code     => 'Page',
 273                         error_message   => 'Verbiage',
 274                         authorization   => 'ApprovalCode',
 275                         avs_response    => 'AVSResponseCode',
 276                         cvv2_response   => 'CVV2ResponseCode',
 277
 278                         receipt_number  => 'ReceiptNumber',
 279                         sales_number    => 'SalesOrderNumber',
 280                         uuid            => 'GUID',
 281                         guid            => 'GUID',
 282
 283                         date            => 'Date',
 284                         cardholder      => 'xxxName',
 285                         card_type       => 'CardType',
 286                         total_amount    => 'TotalAmount',
 287                         );
 288
 289         $self->is_success(scalar grep $self->result_code eq $_, SUCCESS_CODES);
 290
 291         # Completely undocumented field that sometimes override <Verbiage>
 292         $self->error_message($response->{Error}) if $response->{Error};
 293
 294         # Delete error_message if transaction was successful
 295         $self->error_message(undef) if $self->is_success;
 296
 297         $self->card_type(CARD_TYPES->{$self->card_type});
 298
 299         $self->tax_amounts( { $self->extract_tax_amounts($response) } );
 300
 301         return $self;
 302 }
 303
 304 sub submit {
 305         my ($self) = @_;
 306
 307         croak "Missing required argument 'merchant_id'"
 308                 unless defined $self->{merchant_id};
 309
 310         my ($page, $response, %headers) =
 311                 post_https(
 312                                 $self->server,
 313                                 $self->port,
 314                                 $self->path,
 315                                 undef,
 316                                 make_form(
 317                                         xxxRequestMode => 'X',
 318                                         xxxRequestData => $self->to_xml,
 319                                 )
 320                         );
 321
 322         croak 'Error connecting to server' unless $page;
 323         croak 'Server responded, but not in XML' unless $page =~ /^<\?xml/;
 324
 325         # The response is marked UTF-8, but it's really Latin-1.  Sigh.
 326         $page =~ s/^(<\?xml.*?) encoding="utf-8"/$1 encoding="iso-8859-1"/si;
 327
 328         $self->parse_response($page);
 329 }
 330
 331
 332 1;
 333
 334 __END__
 335
 336
 337 =head1 NAME
 338
 339 Business::OnlinePayment::InternetSecure - InternetSecure backend for Business::OnlinePayment
 340
 341 =head1 SYNOPSIS
 342
 343   use Business::OnlinePayment;
 344
 345   $txn = new Business::OnlinePayment 'InternetSecure',
 346                                         merchant_id => '0000';
 347
 348   $txn->content(
 349         action          => 'Normal Authorization',
 350
 351         type            => 'Visa',                      # Optional
 352         card_number     => '4111 1111 1111 1111',
 353         exp_date        => '2004-07',
 354         cvv2            => '000',                       # Optional
 355
 356         name            => "Fr\x{e9}d\x{e9}ric Bri\x{e8}re",
 357         company         => '',
 358         address         => '123 Street',
 359         city            => 'Metropolis',
 360         state           => 'ZZ',
 361         zip             => 'A1A 1A1',
 362         country         => 'CA',
 363         phone           => '(555) 555-1212',
 364         email           => 'fbriere@fbriere.net',
 365
 366         amount          => 49.95,
 367         currency        => 'CAD',
 368         taxes           => 'GST PST',
 369         description     => 'Test transaction',
 370         );
 371
 372   $txn->submit;
 373
 374   if ($txn->is_success) {
 375         print "Card processed successfully: " . $tx->authorization . "\n";
 376   } else {
 377         print "Card was rejected: " . $tx->error_message . "\n";
 378   }
 379
 380 =head1 DESCRIPTION
 381
 382 C<Business::OnlinePayment::InternetSecure> is an implementation of
 383 C<Business::OnlinePayment> that allows for processing online credit card
 384 payments through InternetSecure.
 385
 386 See L<Business::OnlinePayment> for more information about the generic
 387 Business::OnlinePayment interface.
 388
 389 =head1 CREATOR
 390
 391 Object creation is done via C<Business::OnlinePayment>; see its manpage for
 392 details.  The B<merchant_id> processor option is required, and corresponds
 393 to the merchant ID assigned to you by InternetSecure.
 394
 395 =head1 METHODS
 396
 397 =head2 Transaction setup and transmission
 398
 399 =over 4
 400
 401 =item content( CONTENT )
 402
 403 Sets up the data prior to a transaction.  CONTENT is an associative array
 404 (hash), containing some of the following fields:
 405
 406 =over 4
 407
 408 =item action (required)
 409
 410 What to do with the transaction.  Only C<Normal Authorization> is supported
 411 at the moment.
 412
 413 =item type
 414
 415 Transaction type, being one of the following:
 416
 417 =over 4
 418
 419 =item - Visa
 420
 421 =item - MasterCard
 422
 423 =item - American Express
 424
 425 =item - Discover
 426
 427 =back
 428
 429 (This is actually ignored for the moment, and can be left blank or undefined.)
 430
 431 =item card_number (required)
 432
 433 Credit card number.  Spaces and dashes are automatically removed.
 434
 435 =item exp_date (required)
 436
 437 Credit card expiration date.  Since C<Business::OnlinePayment> does not specify
 438 any syntax, this module is rather lax regarding what it will accept.  The
 439 recommended syntax is C<YYYY-MM>, but forms such as C<MM/YYYY> or C<MMYY> are
 440 allowed as well.
 441
 442 =item cvv2
 443
 444 Three- or four-digit verification code printed on the card.  This can be left
 445 blank or undefined, in which case no check will be performed.  Whether or not a
 446 transaction will be declined in case of a mismatch depends on the merchant
 447 account configuration.
 448
 449 This number may be called Card Verification Value (CVV2), Card Validation
 450 Code (CVC2) or Card Identification number (CID), depending on the card issuer.
 451
 452 =item description
 453
 454 A short description of the transaction.  See L<"Products list syntax"> for
 455 an alternate syntax that allows a list of products to be specified.
 456
 457 =item amount (usually required)
 458
 459 Total amount to be billed, excluding taxes if they are to be added separately
 460 by InternetSecure.
 461
 462 This field is required if B<description> is a string, but should be left
 463 undefined if B<description> contains a list of products instead, as outlined
 464 in L<"Products list syntax">.
 465
 466 =item currency
 467
 468 Currency of all amounts for this order.  This can currently be either
 469 C<CAD> (default) or C<USD>.
 470
 471 =item taxes
 472
 473 Taxes to be added automatically to B<amount> by InternetSecure.  Available
 474 taxes are C<GST>, C<PST> and C<HST>.
 475
 476 This argument can either be a single string of taxes concatenated with spaces
 477 (such as C<GST PST>), or a reference to an array of taxes (such as C<[ "GST",
 478 "PST" ]>).
 479
 480 =item name / company / address / city / state / zip / country / phone / email
 481
 482 Customer information.  B<country> should be a two-letter code taken from ISO
 483 3166-1.
 484
 485 =back
 486
 487 =item submit()
 488
 489 Submit the transaction to InternetSecure.
 490
 491 =back
 492
 493 =head2 Post-submission methods
 494
 495 =over 4
 496
 497 =item is_success()
 498
 499 Returns true if the transaction was submitted successfully.
 500
 501 =item result_code()
 502
 503 Response code returned by InternetSecure.
 504
 505 =item error_message()
 506
 507 Error message if the transaction was unsuccessful; C<undef> otherwise.  (You
 508 should not rely on this to test whether a transaction was successful; use
 509 B<is_success>() instead.)
 510
 511 =item receipt_number()
 512
 513 Receipt number (a string, actually) of this transaction, unique to all
 514 InternetSecure transactions.
 515
 516 =item sales_number()
 517
 518 Sales order number of this transaction.  This is a number, unique to each
 519 merchant, which is incremented by 1 each time.
 520
 521 =item uuid()
 522
 523 Universally Unique Identifier associated to this transaction.  This is a
 524 128-bit value returned as a 36-character string such as
 525 C<f81d4fae-7dec-11d0-a765-00a0c91e6bf6>.  See RFC 4122 for more details on
 526 UUIDs.
 527
 528 B<guid>() is provided as an alias to this method.
 529
 530 =item authorization()
 531
 532 Authorization code for this transaction.
 533
 534 =item avs_response() / cvv2_response()
 535
 536 Results of the AVS and CVV2 checks.  See the InternetSecure documentation for
 537 the list of possible values.
 538
 539 =item date()
 540
 541 Date and time of the transaction.  Format is C<YYYY/MM/DD hh:mm:ss>.
 542
 543 =item total_amount()
 544
 545 Total amount billed for this order, including taxes.
 546
 547 =item tax_amounts()
 548
 549 Returns a I<reference> to a hash that maps taxes, which were listed under the
 550 B<taxes> argument to B<submit>(), to the amount that was calculated by
 551 InternetSecure.
 552
 553 =item cardholder()
 554
 555 Cardholder's name.  This is currently a mere copy of the B<name> field passed
 556 to B<submit>().
 557
 558 =item card_type()
 559
 560 Type of the credit card used for the submitted order, being one of the
 561 following:
 562
 563 =over 4
 564
 565 =item - Visa
 566
 567 =item - MasterCard
 568
 569 =item - American Express
 570
 571 =item - Discover
 572
 573 =back
 574
 575
 576 =back
 577
 578
 579 =head1 NOTES
 580
 581 =head2 Products list syntax
 582
 583 Optionally, the B<description> field of B<content>() can contain a reference
 584 to an array of products, instead of a simple string.  Each element of this
 585 array represents a different product, and must be a reference to a hash with
 586 the following fields:
 587
 588 =over 4
 589
 590 =item amount
 591
 592 Unit price of this product.
 593
 594 =item quantity
 595
 596 Ordered quantity of this product.
 597
 598 =item sku
 599
 600 Internal code for this product.
 601
 602 =item description
 603
 604 Description of this product
 605
 606 =item taxes
 607
 608 Taxes that should be automatically added to this product.  If specified, this
 609 overrides the B<taxes> field passed to B<content>().
 610
 611 =back
 612
 613 When using a products list, the B<amount> field passed to B<content>() should
 614 be left undefined.
 615
 616
 617 =head2 Character encoding
 618
 619 Since communication to/from InternetSecure is encoded with UTF-8, all Unicode
 620 characters are theoretically available when submitting information via
 621 B<submit>().  (Further restrictions may be imposed by InternetSecure itself.)
 622
 623 When using non-ASCII characters, all data provided to B<submit>() should either
 624 be in the current native encoding (typically latin-1, unless it was modified
 625 via the C<encoding> pragma), or be decoded via the C<Encode> module.
 626 Conversely, all data returned after calling B<submit>() will be automatically
 627 decoded.
 628
 629
 630 =head1 EXPORT
 631
 632 None by default.
 633
 634
 635 =head1 SEE ALSO
 636
 637 L<Business::OnlinePayment>
 638
 639 =head1 AUTHOR
 640
 641 Frédéric Brière, E<lt>fbriere@fbriere.netE<gt>
 642
 643 =head1 COPYRIGHT AND LICENSE
 644
 645 Copyright (C) 2006 by Frédéric Brière
 646
 647 This library is free software; you can redistribute it and/or modify
 648 it under the same terms as Perl itself, either Perl version 5.8.4 or,
 649 at your option, any later version of Perl 5 you may have available.
 650
 651
 652 =cut