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         $self->card_type(CARD_TYPES->{$self->card_type});
 265
 266         $self->{products_raw} = $response->{Products};
 267
 268         return $self;
 269 }
 270
 271 sub submit {
 272         my ($self) = @_;
 273
 274         croak "Missing required argument 'merchant_id'"
 275                 unless defined $self->{merchant_id};
 276
 277         my ($page, $response, %headers) =
 278                 post_https(
 279                                 $self->server,
 280                                 $self->port,
 281                                 $self->path,
 282                                 undef,
 283                                 make_form(
 284                                         xxxRequestMode => 'X',
 285                                         xxxRequestData => $self->to_xml,
 286                                 )
 287                         );
 288
 289         croak 'Error connecting to server' unless $page;
 290         croak 'Server responded, but not in XML' unless $page =~ /^<\?xml/;
 291
 292         # The response is marked UTF-8, but it's really Latin-1.  Sigh.
 293         $page =~ s/^(<\?xml.*?) encoding="utf-8"/$1 encoding="iso-8859-1"/si;
 294
 295         $self->parse_response($page);
 296 }
 297
 298
 299 1;
 300
 301 __END__
 302
 303
 304 =head1 NAME
 305
 306 Business::OnlinePayment::InternetSecure - InternetSecure backend for Business::OnlinePayment
 307
 308 =head1 SYNOPSIS
 309
 310   use Business::OnlinePayment;
 311
 312   $txn = new Business::OnlinePayment 'InternetSecure',
 313                                         merchant_id => '0000';
 314
 315   $txn->content(
 316         action          => 'Normal Authorization',
 317
 318         type            => 'Visa',                      # Optional
 319         card_number     => '4111 1111 1111 1111',
 320         exp_date        => '2004-07',
 321         cvv2            => '000',                       # Optional
 322
 323         name            => "Fr\x{e9}d\x{e9}ric Bri\x{e8}re",
 324         company         => '',
 325         address         => '123 Street',
 326         city            => 'Metropolis',
 327         state           => 'ZZ',
 328         zip             => 'A1A 1A1',
 329         country         => 'CA',
 330         phone           => '(555) 555-1212',
 331         email           => 'fbriere@fbriere.net',
 332
 333         amount          => 49.95,
 334         currency        => 'CAD',
 335         taxes           => 'GST PST',
 336         description     => 'Test transaction',
 337         );
 338
 339   $txn->submit;
 340
 341   if ($txn->is_success) {
 342         print "Card processed successfully: " . $tx->authorization . "\n";
 343   } else {
 344         print "Card was rejected: " . $tx->error_message . "\n";
 345   }
 346
 347 =head1 DESCRIPTION
 348
 349 C<Business::OnlinePayment::InternetSecure> is an implementation of
 350 C<Business::OnlinePayment> that allows for processing online credit card
 351 payments through InternetSecure.
 352
 353 See L<Business::OnlinePayment> for more information about the generic
 354 Business::OnlinePayment interface.
 355
 356 =head1 CREATOR
 357
 358 Object creation is done via C<Business::OnlinePayment>; see its manpage for
 359 details.  The B<merchant_id> processor option is required, and corresponds
 360 to the merchant ID assigned to you by InternetSecure.
 361
 362 =head1 METHODS
 363
 364 =head2 Transaction setup and transmission
 365
 366 =over 4
 367
 368 =item content( CONTENT )
 369
 370 Sets up the data prior to a transaction.  CONTENT is an associative array
 371 (hash), containing some of the following fields:
 372
 373 =over 4
 374
 375 =item action (required)
 376
 377 What to do with the transaction.  Only C<Normal Authorization> is supported
 378 at the moment.
 379
 380 =item type
 381
 382 Transaction type, being one of the following:
 383
 384 =over 4
 385
 386 =item - Visa
 387
 388 =item - MasterCard
 389
 390 =item - American Express
 391
 392 =item - Discover
 393
 394 =back
 395
 396 (This is actually ignored for the moment, and can be left blank or undefined.)
 397
 398 =item card_number (required)
 399
 400 Credit card number.  Spaces and dashes are automatically removed.
 401
 402 =item exp_date (required)
 403
 404 Credit card expiration date.  Since C<Business::OnlinePayment> does not specify
 405 any syntax, this module is rather lax regarding what it will accept.  The
 406 recommended syntax is C<YYYY-MM>, but forms such as C<MM/YYYY> or C<MMYY> are
 407 allowed as well.
 408
 409 =item cvv2
 410
 411 Three- or four-digit verification code printed on the card.  This can be left
 412 blank or undefined, in which case no check will be performed.  Whether or not a
 413 transaction will be declined in case of a mismatch depends on the merchant
 414 account configuration.
 415
 416 This number may be called Card Verification Value (CVV2), Card Validation
 417 Code (CVC2) or Card Identification number (CID), depending on the card issuer.
 418
 419 =item description
 420
 421 A short description of the transaction.  See L<"Products list syntax"> for
 422 an alternate syntax that allows a list of products to be specified.
 423
 424 =item amount (usually required)
 425
 426 Total amount to be billed, excluding taxes if they are to be added separately
 427 by InternetSecure.
 428
 429 This field is required if B<description> is a string, but should be left
 430 undefined if B<description> contains a list of products instead, as outlined
 431 in L<"Products list syntax">.
 432
 433 =item currency
 434
 435 Currency of all amounts for this order.  This can currently be either
 436 C<CAD> (default) or C<USD>.
 437
 438 =item taxes
 439
 440 Taxes to be added automatically to B<amount> by InternetSecure.
 441
 442 Available taxes are C<GST>, C<PST> and C<HST>.  Multiple taxes can specified
 443 by concatenating them with spaces, such as C<GST HST>.
 444
 445 =item name / company / address / city / state / zip / country / phone / email
 446
 447 Customer information.  B<country> should be a two-letter code taken from ISO
 448 3166-1.
 449
 450 =back
 451
 452 =item submit()
 453
 454 Submit the transaction to InternetSecure.
 455
 456 =back
 457
 458 =head2 Post-submission methods
 459
 460 =over 4
 461
 462 =item is_success()
 463
 464 Returns true if the transaction was submitted successfully.
 465
 466 =item result_code()
 467
 468 Response code returned by InternetSecure.
 469
 470 =item error_message()
 471
 472 Text description of the response code.  (Do not rely on this to check for
 473 errors, as a description will also be returned for successful transactions.
 474 Use B<is_success>() instead.)
 475
 476 =item receipt_number()
 477
 478 Receipt number (a string, actually) of this transaction, unique to all
 479 InternetSecure transactions.
 480
 481 =item sales_number()
 482
 483 Sales order number of this transaction.  This is a number, unique to each
 484 merchant, which is incremented by 1 each time.
 485
 486 =item uuid()
 487
 488 Universally Unique Identifier associated to this transaction.  This is a
 489 128-bit value returned as a 36-character string such as
 490 C<f81d4fae-7dec-11d0-a765-00a0c91e6bf6>.  See RFC 4122 for more details on
 491 UUIDs.
 492
 493 B<guid>() is provided as an alias to this method.
 494
 495 =item authorization()
 496
 497 Authorization code for this transaction.
 498
 499 =item avs_response() / cvv2_response()
 500
 501 Results of the AVS and CVV2 checks.  See the InternetSecure documentation for
 502 the list of possible values.
 503
 504 =item date()
 505
 506 Date and time of the transaction.  Format is C<YYYY/MM/DD hh:mm:ss>.
 507
 508 =item total_amount()
 509
 510 Total amount billed for this order, including taxes.
 511
 512 =item cardholder()
 513
 514 Cardholder's name.  This is currently a mere copy of the B<name> field passed
 515 to B<submit>().
 516
 517 =item card_type()
 518
 519 Type of the credit card used for the submitted order, being one of the
 520 following:
 521
 522 =over 4
 523
 524 =item - Visa
 525
 526 =item - MasterCard
 527
 528 =item - American Express
 529
 530 =item - Discover
 531
 532 =back
 533
 534 =item products_raw()
 535
 536 ...
 537
 538
 539 =back
 540
 541
 542 =head1 NOTES
 543
 544 =head2 Products list syntax
 545
 546 Optionally, the B<description> field of B<content>() can contain a reference
 547 to an array of products, instead of a simple string.  Each element of this
 548 array represents a different product, and must be a reference to a hash with
 549 the following fields:
 550
 551 =over 4
 552
 553 =item amount
 554
 555 Unit price of this product.
 556
 557 =item quantity
 558
 559 Ordered quantity of this product.
 560
 561 =item sku
 562
 563 Internal code for this product.
 564
 565 =item description
 566
 567 Description of this product
 568
 569 =item taxes
 570
 571 Taxes that should be automatically added to this product.  If specified, this
 572 overrides the B<taxes> field passed to B<content>().
 573
 574 =back
 575
 576 When using a products list, the B<amount> field passed to B<content>() should
 577 be left undefined.
 578
 579
 580 =head2 Character encoding
 581
 582 Since communication to/from InternetSecure is encoded with UTF-8, all Unicode
 583 characters are theoretically available when submitting information via
 584 B<submit>().  (Further restrictions may be imposed by InternetSecure itself.)
 585
 586 When using non-ASCII characters, all data provided to B<submit>() should either
 587 be in the current native encoding (typically latin-1, unless it was modified
 588 via the C<encoding> pragma), or be decoded via the C<Encode> module.
 589 Conversely, all data returned after calling B<submit>() will be automatically
 590 decoded.
 591
 592
 593 =head1 EXPORT
 594
 595 None by default.
 596
 597
 598 =head1 SEE ALSO
 599
 600 L<Business::OnlinePayment>
 601
 602 =head1 AUTHOR
 603
 604 Frédéric Brière, E<lt>fbriere@fbriere.netE<gt>
 605
 606 =head1 COPYRIGHT AND LICENSE
 607
 608 Copyright (C) 2006 by Frédéric Brière
 609
 610 This library is free software; you can redistribute it and/or modify
 611 it under the same terms as Perl itself, either Perl version 5.8.4 or,
 612 at your option, any later version of Perl 5 you may have available.
 613
 614
 615 =cut