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         # (It's not quite clear whether there should be some decoding, or if
 234         # 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.  Any spaces will be removed.
 398
 399 =item exp_date (required)
 400
 401 Credit card expiration date.  Since L<Business::OnlinePayment> does not
 402 specify any syntax, this module is rather lax in what it will accept.  It is
 403 recommended to use either I<YYYY-MM> or I<MM/YYYY>, to avoid any nasty
 404 surprises.
 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
 412 This number may be called Card Verification Value (CVV2), Card Validation
 413 Code (CVC2) or Card Identification number (CID).
 414
 415 =item description
 416
 417 A short description of the purchase.  See L<"Products list syntax"> for
 418 an alternate syntax that allows a list of products to be specified.
 419
 420 =item amount
 421
 422 Total amount to be billed, excluding taxes if they are to be added separately.
 423 This field is required if B<description> is a string, and should be left
 424 undefined if B<description> contains a list of products, as outlined in
 425 L<"Products list syntax">.
 426
 427 =item currency
 428
 429 Currency of all amounts for this order.  This can currently be either
 430 C<CAN> (default) or C<USD>.
 431
 432 =item taxes
 433
 434 Taxes to be added automatically.  These should not be included in B<amount>;
 435 they will be added by Internet Secure later on.
 436
 437 Available taxes are C<GST>, C<PST> and C<HST>; multiple taxes must be
 438 separated by spaces.
 439
 440 =item name / company / address / city / state / zip / country / phone / email
 441
 442 Facultative customer information.  B<state> should be either a postal
 443 abbreviation or a two-letter code taken from ISO 3166-2, and B<country> should
 444 be a two-letter code taken from in ISO 3166-1.
 445
 446 =back
 447
 448 =back
 449
 450 =head2 After order submission
 451
 452 =over 4
 453
 454 =item receipt_number() / sales_order_number()
 455
 456 Receipt number and sales order number of submitted order.
 457
 458 =item total_amount()
 459
 460 Total amount billed for this order, including taxes.
 461
 462 =item cardholder()
 463
 464 Cardholder's name.  This is currently a mere copy of the B<name> field passed
 465 to B<submit()>.
 466
 467 =item card_type()
 468
 469 Type of the credit card used for the submitted order, being one of the
 470 following:
 471
 472 =over 4
 473
 474 =item - Visa
 475
 476 =item - MasterCard
 477
 478 =item - American Express
 479
 480 =item - Discover
 481
 482 =back
 483
 484 =item avs_response() / cvv2_response()
 485
 486 Results of the AVS and CVV2 checks.  See the Internet Secure documentation for
 487 the list of possible values.
 488
 489 =back
 490
 491
 492 =head1 NOTES
 493
 494 =head2 Products list syntax
 495
 496 Optionally, the B<description> field of B<content()> can contain a reference
 497 to an array of products, instead of a simple string.  Each element of this
 498 array represents a different product, and must be a reference to a hash with
 499 the following fields:
 500
 501 =over 4
 502
 503 =item amount
 504
 505 Unit price of this product.
 506
 507 =item quantity
 508
 509 Ordered quantity of this product.  This can be a decimal value.
 510
 511 =item sku
 512
 513 Internal code for this product.
 514
 515 =item description
 516
 517 Description of this product
 518
 519 =item taxes
 520
 521 Taxes that should be automatically added to this product.  If specified, this
 522 overrides the B<taxes> field passed to B<content()>.
 523
 524 =back
 525
 526 When using a products list, the B<amount> field passed to B<content()> should
 527 be left undefined.
 528
 529
 530 =head2 Character encodings
 531
 532 ...
 533
 534
 535 =head2 products_raw
 536
 537 ...
 538
 539
 540 =head1 EXPORT
 541
 542 None by default.
 543
 544
 545 =head1 SEE ALSO
 546
 547 L<Business::OnlinePayment>
 548
 549 =head1 AUTHOR
 550
 551 Frederic Briere, E<lt>fbriere@fbriere.netE<gt>
 552
 553 =head1 COPYRIGHT AND LICENSE
 554
 555 Copyright (C) 2004 by Frederic Briere
 556
 557 This library is free software; you can redistribute it and/or modify
 558 it under the same terms as Perl itself, either Perl version 5.8.4 or,
 559 at your option, any later version of Perl 5 you may have available.
 560
 561
 562 =cut