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