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