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