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