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