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