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