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