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