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