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    taxes
  46                                 avs_response    cvv2_response
  47                         ));
  48
  49         # Just in case someone tries to call taxes() *before* submit()
  50         $self->taxes( {} );
  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         foreach (ref $data{taxes} ?
 112                         @{ $data{taxes} } :
 113                         split(' ' => $data{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 exp_date));
 139
 140         croak 'Unsupported transaction type'
 141                 if $content{type} && $content{type} !~
 142                         /^(Visa|MasterCard|American Express|Discover)$/i;
 143
 144         croak 'Unsupported action'
 145                 unless $content{action} =~ /^Normal Authori[zs]ation$/i;
 146
 147         $content{currency} = uc($content{currency} || 'CAD');
 148         croak "Unknown currency code ", $content{currency}
 149                 unless $content{currency} =~ /^(CAD|USD)$/;
 150
 151         $content{taxes} = uc($content{taxes} || '');
 152
 153         my %data = $self->get_remap_fields(qw(
 154                         xxxCard_Number          card_number
 155
 156                         xxxName                 name
 157                         xxxCompany              company
 158                         xxxAddress              address
 159                         xxxCity                 city
 160                         xxxProvince             state
 161                         xxxPostal               zip
 162                         xxxCountry              country
 163                         xxxPhone                phone
 164                         xxxEmail                email
 165
 166                         xxxShippingName         ship_name
 167                         xxxShippingCompany      ship_company
 168                         xxxShippingAddress      ship_address
 169                         xxxShippingCity         ship_city
 170                         xxxShippingProvince     ship_state
 171                         xxxShippingPostal       ship_zip
 172                         xxxShippingCountry      ship_country
 173                         xxxShippingPhone        ship_phone
 174                         xxxShippingEmail        ship_email
 175                 ));
 176
 177         $data{MerchantNumber} = $self->merchant_id;
 178
 179         $data{xxxCard_Number} =~ tr/- //d;
 180         $data{xxxCard_Number} =~ s/^[^3-6]/4/ if $self->test_transaction;
 181
 182         my ($y, $m) = $self->parse_expdate($content{exp_date});
 183         $data{xxxCCYear} = sprintf '%.4u' => $y;
 184         $data{xxxCCMonth} = sprintf '%.2u' => $m;
 185
 186         if (defined $content{cvv2} && $content{cvv2} ne '') {
 187                 $data{CVV2} = 1;
 188                 $data{CVV2Indicator} = $content{cvv2};
 189         } else {
 190                 $data{CVV2} = 0;
 191                 $data{CVV2Indicator} = '';
 192         }
 193
 194         if (ref $content{description}) {
 195                 $data{Products} = join '|' => map $self->prod_string(
 196                                                 $content{currency},
 197                                                 taxes => $content{taxes},
 198                                                 %$_),
 199                                         @{ $content{description} };
 200         } else {
 201                 $self->required_fields(qw(amount));
 202                 $data{Products} = $self->prod_string(
 203                                         $content{currency},
 204                                         taxes       => $content{taxes},
 205                                         amount      => $content{amount},
 206                                         description => $content{description},
 207                                 );
 208         }
 209
 210         xml_out(\%data,
 211                 NoAttr          => 1,
 212                 NumericEscape   => 2,
 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_taxes {
 232         my ($self, $response) = @_;
 233
 234         my %taxes;
 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                         $taxes{ $node->{code} } = $node->{subtotal};
 246                 }
 247         }
 248
 249         return %taxes;
 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->taxes( { $self->extract_taxes($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         exp_date        => '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 =back
 425
 426 (This is actually ignored for the moment, and can be left blank or undefined.)
 427
 428 =item card_number (required)
 429
 430 Credit card number.  Spaces and dashes are automatically removed.
 431
 432 =item exp_date (required)
 433
 434 Credit card expiration date.  Since C<Business::OnlinePayment> does not specify
 435 any syntax, this module is rather lax regarding what it will accept.  The
 436 recommended syntax is C<YYYY-MM>, but forms such as C<MM/YYYY> or C<MMYY> are
 437 allowed as well.
 438
 439 =item cvv2
 440
 441 Three- or four-digit verification code printed on the card.  This can be left
 442 blank or undefined, in which case no check will be performed.  Whether or not a
 443 transaction will be declined in case of a mismatch depends on the merchant
 444 account configuration.
 445
 446 This number may be called Card Verification Value (CVV2), Card Validation
 447 Code (CVC2) or Card Identification number (CID), depending on the card issuer.
 448
 449 =item description
 450
 451 A short description of the transaction.  See L<"Products list syntax"> for
 452 an alternate syntax that allows a list of products to be specified.
 453
 454 =item amount (usually required)
 455
 456 Total amount to be billed, excluding taxes if they are to be added separately
 457 by InternetSecure.
 458
 459 This field is required if B<description> is a string, but should be left
 460 undefined if B<description> contains a list of products instead, as outlined
 461 in L<"Products list syntax">.
 462
 463 =item currency
 464
 465 Currency of all amounts for this order.  This can currently be either
 466 C<CAD> (default) or C<USD>.
 467
 468 =item taxes
 469
 470 Taxes to be added automatically to B<amount> by InternetSecure.
 471
 472 Available taxes are C<GST>, C<PST> and C<HST>.  Multiple taxes can specified
 473 by concatenating them with spaces, such as C<GST HST>.
 474
 475 =item name / company / address / city / state / zip / country / phone / email
 476
 477 Customer information.  B<country> should be a two-letter code taken from ISO
 478 3166-1.
 479
 480 =back
 481
 482 =item submit()
 483
 484 Submit the transaction to InternetSecure.
 485
 486 =back
 487
 488 =head2 Post-submission methods
 489
 490 =over 4
 491
 492 =item is_success()
 493
 494 Returns true if the transaction was submitted successfully.
 495
 496 =item result_code()
 497
 498 Response code returned by InternetSecure.
 499
 500 =item error_message()
 501
 502 Error message if the transaction was unsuccessful; C<undef> otherwise.  (You
 503 should not rely on this to test whether a transaction was successful; use
 504 B<is_success>() instead.)
 505
 506 =item receipt_number()
 507
 508 Receipt number (a string, actually) of this transaction, unique to all
 509 InternetSecure transactions.
 510
 511 =item sales_number()
 512
 513 Sales order number of this transaction.  This is a number, unique to each
 514 merchant, which is incremented by 1 each time.
 515
 516 =item uuid()
 517
 518 Universally Unique Identifier associated to this transaction.  This is a
 519 128-bit value returned as a 36-character string such as
 520 C<f81d4fae-7dec-11d0-a765-00a0c91e6bf6>.  See RFC 4122 for more details on
 521 UUIDs.
 522
 523 B<guid>() is provided as an alias to this method.
 524
 525 =item authorization()
 526
 527 Authorization code for this transaction.
 528
 529 =item avs_response() / cvv2_response()
 530
 531 Results of the AVS and CVV2 checks.  See the InternetSecure documentation for
 532 the list of possible values.
 533
 534 =item date()
 535
 536 Date and time of the transaction.  Format is C<YYYY/MM/DD hh:mm:ss>.
 537
 538 =item total_amount()
 539
 540 Total amount billed for this order, including taxes.
 541
 542 =item taxes()
 543
 544 Returns a I<reference> to a hash that maps tax names (such as C<GST>) to the
 545 amount that was billed for each.
 546
 547 =item cardholder()
 548
 549 Cardholder's name.  This is currently a mere copy of the B<name> field passed
 550 to B<submit>().
 551
 552 =item card_type()
 553
 554 Type of the credit card used for the submitted order, being one of the
 555 following:
 556
 557 =over 4
 558
 559 =item - Visa
 560
 561 =item - MasterCard
 562
 563 =item - American Express
 564
 565 =item - Discover
 566
 567 =back
 568
 569
 570 =back
 571
 572
 573 =head1 NOTES
 574
 575 =head2 Products list syntax
 576
 577 Optionally, the B<description> field of B<content>() can contain a reference
 578 to an array of products, instead of a simple string.  Each element of this
 579 array represents a different product, and must be a reference to a hash with
 580 the following fields:
 581
 582 =over 4
 583
 584 =item amount
 585
 586 Unit price of this product.
 587
 588 =item quantity
 589
 590 Ordered quantity of this product.
 591
 592 =item sku
 593
 594 Internal code for this product.
 595
 596 =item description
 597
 598 Description of this product
 599
 600 =item taxes
 601
 602 Taxes that should be automatically added to this product.  If specified, this
 603 overrides the B<taxes> field passed to B<content>().
 604
 605 =back
 606
 607 When using a products list, the B<amount> field passed to B<content>() should
 608 be left undefined.
 609
 610
 611 =head2 Character encoding
 612
 613 Since communication to/from InternetSecure is encoded with UTF-8, all Unicode
 614 characters are theoretically available when submitting information via
 615 B<submit>().  (Further restrictions may be imposed by InternetSecure itself.)
 616
 617 When using non-ASCII characters, all data provided to B<submit>() should either
 618 be in the current native encoding (typically latin-1, unless it was modified
 619 via the C<encoding> pragma), or be decoded via the C<Encode> module.
 620 Conversely, all data returned after calling B<submit>() will be automatically
 621 decoded.
 622
 623
 624 =head1 EXPORT
 625
 626 None by default.
 627
 628
 629 =head1 SEE ALSO
 630
 631 L<Business::OnlinePayment>
 632
 633 =head1 AUTHOR
 634
 635 Frédéric Brière, E<lt>fbriere@fbriere.netE<gt>
 636
 637 =head1 COPYRIGHT AND LICENSE
 638
 639 Copyright (C) 2006 by Frédéric Brière
 640
 641 This library is free software; you can redistribute it and/or modify
 642 it under the same terms as Perl itself, either Perl version 5.8.4 or,
 643 at your option, any later version of Perl 5 you may have available.
 644
 645
 646 =cut