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