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