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