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
 188         my ($y, $m) = $self->parse_expdate($content{exp_date});
 189         $data{xxxCCYear} = sprintf '%.4u' => $y;
 190         $data{xxxCCMonth} = sprintf '%.2u' => $m;
 191
 192         if (defined $content{cvv2} && $content{cvv2} ne '') {
 193                 $data{CVV2} = 1;
 194                 $data{CVV2Indicator} = $content{cvv2};
 195         } else {
 196                 $data{CVV2} = 0;
 197                 $data{CVV2Indicator} = '';
 198         }
 199
 200         if (ref $content{description}) {
 201                 $data{Products} = join '|' => map $self->prod_string(
 202                                                         $content{currency},
 203                                                         $content{taxes},
 204                                                         %$_),
 205                                                 @{ $content{description} };
 206         } else {
 207                 $self->required_fields(qw(amount));
 208                 $data{Products} = $self->prod_string(
 209                                         $content{currency},
 210                                         $content{taxes},
 211                                         amount => $content{amount},
 212                                         description => $content{description},
 213                                 );
 214         }
 215
 216         xml_out(\%data,
 217                 NoAttr => 1,
 218                 RootName => 'TranxRequest',
 219                 SuppressEmpty => undef,
 220                 XMLDecl => '<?xml version="1.0" encoding="utf-8" standalone="yes"?>',
 221         );
 222 }
 223
 224 # Map the various fields from the response, and put their values into our
 225 # object for retrieval.
 226 #
 227 sub infuse {
 228         my ($self, $data, %map) = @_;
 229
 230         while (my ($k, $v) = each %map) {
 231                 no strict 'refs';
 232                 $self->$v($data->{$k});
 233         }
 234 }
 235
 236 # Parse the server's response and set various fields
 237 #
 238 sub parse_response {
 239         my ($self, $response) = @_;
 240
 241         $self->server_response($response);
 242
 243         $response = xml_in($response,
 244                         ForceArray => [qw(product flag)],
 245                         GroupTags => { qw(Products product flags flag) },
 246                         KeyAttr => [],
 247                         SuppressEmpty => undef,
 248                 );
 249
 250         my $code = $self->result_code($response->{Page});
 251         $self->is_success($code eq '2000' || $code eq '90000' || $code eq '900P1');
 252
 253         $self->infuse($response, qw(
 254                         ReceiptNumber           receipt_number
 255                         SalesOrderNumber        sales_order_number
 256                         xxxName                 cardholder
 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         $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 (See L<Business::OnlinePayment> for more methods.)
 366
 367 =head2 Before order submission
 368
 369 =over 4
 370
 371 =item content( CONTENT )
 372
 373 Sets up the data prior to a transaction (overwriting any previous data by the
 374 same occasion).  CONTENT is an associative array (hash), containing some of
 375 the following fields:
 376
 377 =over 4
 378
 379 =item action (required)
 380
 381 What to do with the transaction.  Only C<Normal Authorization> is supported
 382 for the moment.
 383
 384 =item type
 385
 386 Transaction type, being one of the following:
 387
 388 =over 4
 389
 390 =item - Visa
 391
 392 =item - MasterCard
 393
 394 =item - American Express
 395
 396 =item - Discover
 397
 398 =back
 399
 400 (This is actually ignored for the moment, and can be left blank or undefined.)
 401
 402 =item card_number (required)
 403
 404 Credit card number.  Spaces are allowed, and will be automatically removed.
 405
 406 =item exp_date (required)
 407
 408 Credit card expiration date.  Since L<Business::OnlinePayment> does not specify
 409 any syntax, this module is rather lax regarding what it will accept.  The
 410 recommended syntax is I<YYYY-MM>, but forms such as I<MM/YYYY> or I<MMYY> are
 411 allowed as well.
 412
 413 =item cvv2
 414
 415 Three- or four-digit verification code printed on the card.  This can be left
 416 blank or undefined, in which case no check will be performed.  Whether or not a
 417 transaction will be declined in case of a mismatch depends on the merchant
 418 account configuration.
 419
 420 This number may be called Card Verification Value (CVV2), Card Validation
 421 Code (CVC2) or Card Identification number (CID), depending on the card issuer.
 422
 423 =item description
 424
 425 A short description of the purchase.  See L<"Products list syntax"> for
 426 an alternate syntax that allows a list of products to be specified.
 427
 428 =item amount
 429
 430 Total amount to be billed, excluding taxes if they are to be added separately.
 431 This field is required if B<description> is a string, and should be left
 432 undefined if B<description> contains a list of products, as outlined in
 433 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.  These should not be included in B<amount>;
 443 they will be automatically added by InternetSecure later on.
 444
 445 Available taxes are C<GST>, C<PST> and C<HST>.  Taxes can be combined by
 446 separating them with spaces, such as C<GST HST>.
 447
 448 =item name / company / address / city / state / zip / country / phone / email
 449
 450 Facultative customer information.  B<state> should be either a postal
 451 abbreviation or a two-letter code taken from ISO 3166-2, and B<country> should
 452 be a two-letter code taken from ISO 3166-1.
 453
 454 =back
 455
 456 =back
 457
 458 =head2 After order submission
 459
 460 =over 4
 461
 462 =item receipt_number() / sales_order_number()
 463
 464 Receipt number and sales order number of submitted order.
 465
 466 =item total_amount()
 467
 468 Total amount billed for this order, including taxes.
 469
 470 =item cardholder()
 471
 472 Cardholder's name.  This is currently a mere copy of the B<name> field passed
 473 to B<submit()>.
 474
 475 =item card_type()
 476
 477 Type of the credit card used for the submitted order, being one of the
 478 following:
 479
 480 =over 4
 481
 482 =item - Visa
 483
 484 =item - MasterCard
 485
 486 =item - American Express
 487
 488 =item - Discover
 489
 490 =back
 491
 492 =item avs_response() / cvv2_response()
 493
 494 Results of the AVS and CVV2 checks.  See the InternetSecure documentation for
 495 the list of possible values.
 496
 497 =item products_raw()
 498
 499 ...
 500
 501
 502 =back
 503
 504
 505 =head1 NOTES
 506
 507 =head2 Products list syntax
 508
 509 Optionally, the B<description> field of B<content()> can contain a reference
 510 to an array of products, instead of a simple string.  Each element of this
 511 array represents a different product, and must be a reference to a hash with
 512 the following fields:
 513
 514 =over 4
 515
 516 =item amount
 517
 518 Unit price of this product.
 519
 520 =item quantity
 521
 522 Ordered quantity of this product.  This can be a decimal value.
 523
 524 =item sku
 525
 526 Internal code for this product.
 527
 528 =item description
 529
 530 Description of this product
 531
 532 =item taxes
 533
 534 Taxes that should be automatically added to this product.  If specified, this
 535 overrides the B<taxes> field passed to B<content()>.
 536
 537 =back
 538
 539 When using a products list, the B<amount> field passed to B<content()> should
 540 be left undefined.
 541
 542
 543 =head2 Character encoding
 544
 545 Since communication to/from InternetSecure is encoded with UTF-8, all Unicode
 546 characters are theoretically available when submitting information via
 547 B<submit()>.  (Further restrictions may be imposed by InternetSecure itself.)
 548
 549 When using non-ASCII characters, all data provided to B<submit()> should either
 550 be in the current native encoding (typically latin-1, unless it was modified
 551 via the C<encoding> pragma), or be decoded via the C<Encode> module.
 552 Conversely, all data returned after calling B<submit()> will be automatically
 553 decoded.
 554
 555
 556 =head1 EXPORT
 557
 558 None by default.
 559
 560
 561 =head1 SEE ALSO
 562
 563 L<Business::OnlinePayment>
 564
 565 =head1 AUTHOR
 566
 567 Frédéric Brière, E<lt>fbriere@fbriere.netE<gt>
 568
 569 =head1 COPYRIGHT AND LICENSE
 570
 571 Copyright (C) 2006 by Frédéric Brière
 572
 573 This library is free software; you can redistribute it and/or modify
 574 it under the same terms as Perl itself, either Perl version 5.8.4 or,
 575 at your option, any later version of Perl 5 you may have available.
 576
 577
 578 =cut