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