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