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