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