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_number
  41                                 date
  42                                 card_type
  43                                 total_amount
  44                                 avs_response    cvv2_response
  45                         ));
  46 }
  47
  48 # OnlinePayment's get_fields now filters out undefs in 3.x. :(
  49 #
  50 sub get_fields {
  51         my ($self, @fields) = @_;
  52
  53         my %content = $self->content;
  54
  55         my %new = map +($_ => $content{$_}), @fields;
  56
  57         return %new;
  58 }
  59
  60 # OnlinePayment's remap_fields is buggy, so we simply rewrite it
  61 #
  62 sub remap_fields {
  63         my ($self, %map) = @_;
  64
  65         my %content = $self->content();
  66         foreach (keys %map) {
  67                 $content{$map{$_}} = delete $content{$_};
  68         }
  69         $self->content(%content);
  70 }
  71
  72 # Combine get_fields and remap_fields for convenience
  73 #
  74 sub get_remap_fields {
  75         my ($self, %map) = @_;
  76
  77         $self->remap_fields(reverse %map);
  78         my %data = $self->get_fields(keys %map);
  79
  80         return %data;
  81 }
  82
  83 # Since there's no standard format for expiration dates, we try to do our best
  84 #
  85 sub parse_expdate {
  86         my ($self, $str) = @_;
  87
  88         local $_ = $str;
  89
  90         my ($y, $m);
  91
  92         if (/^(\d{4})\W(\d{1,2})$/ ||           # YYYY.MM  or  YYYY-M
  93                         /^(\d\d)\W(\d)$/ ||     # YY/M  or  YY-M
  94                         /^(\d\d)[.-](\d\d)$/) { # YY-MM
  95                 ($y, $m) = ($1, $2);
  96         } elsif (/^(\d{1,2})\W(\d{4})$/ ||      # MM-YYYY  or  M/YYYY
  97                         /^(\d)\W(\d\d)$/ ||     # M/YY  or  M-YY
  98                         /^(\d\d)\/?(\d\d)$/) {  # MM/YY  or  MMYY
  99                 ($y, $m) = ($2, $1);
 100         } else {
 101                 croak "Unable to parse expiration date: $str";
 102         }
 103
 104         $y += 2000 if $y < 2000;  # Aren't we glad Y2K is behind us?
 105
 106         return ($y, $m);
 107 }
 108
 109 # Convert a single product into a product string
 110 #
 111 sub prod_string {
 112         my ($self, $currency, %data) = @_;
 113
 114         croak "Missing amount in product" unless defined $data{amount};
 115
 116         my @flags = ($currency);
 117
 118         foreach (split ' ' => uc($data{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} = uc($content{currency} || 'CAD');
 153         croak "Unknown currency code ", $content{currency}
 154                 unless $content{currency} =~ /^(CAD|USD)$/;
 155
 156         $content{taxes} = uc($content{taxes} || '');
 157
 158         my %data = $self->get_remap_fields(qw(
 159                         xxxCard_Number          card_number
 160
 161                         xxxName                 name
 162                         xxxCompany              company
 163                         xxxAddress              address
 164                         xxxCity                 city
 165                         xxxProvince             state
 166                         xxxPostal               zip
 167                         xxxCountry              country
 168                         xxxPhone                phone
 169                         xxxEmail                email
 170
 171                         xxxShippingName         ship_name
 172                         xxxShippingCompany      ship_company
 173                         xxxShippingAddress      ship_address
 174                         xxxShippingCity         ship_city
 175                         xxxShippingProvince     ship_state
 176                         xxxShippingPostal       ship_zip
 177                         xxxShippingCountry      ship_country
 178                         xxxShippingPhone        ship_phone
 179                         xxxShippingEmail        ship_email
 180                 ));
 181
 182         $data{MerchantNumber} = $self->merchant_id;
 183
 184         $data{xxxCard_Number} =~ tr/ //d;
 185         $data{xxxCard_Number} =~ s/^[^3-6]/4/ if $self->test_transaction;
 186
 187         my ($y, $m) = $self->parse_expdate($content{exp_date});
 188         $data{xxxCCYear} = sprintf '%.4u' => $y;
 189         $data{xxxCCMonth} = sprintf '%.2u' => $m;
 190
 191         if (defined $content{cvv2} && $content{cvv2} ne '') {
 192                 $data{CVV2} = 1;
 193                 $data{CVV2Indicator} = $content{cvv2};
 194         } else {
 195                 $data{CVV2} = 0;
 196                 $data{CVV2Indicator} = '';
 197         }
 198
 199         if (ref $content{description}) {
 200                 $data{Products} = join '|' => map $self->prod_string(
 201                                                 $content{currency},
 202                                                 taxes => $content{taxes},
 203                                                 %$_),
 204                                         @{ $content{description} };
 205         } else {
 206                 $self->required_fields(qw(amount));
 207                 $data{Products} = $self->prod_string(
 208                                         $content{currency},
 209                                         taxes       => $content{taxes},
 210                                         amount      => $content{amount},
 211                                         description => $content{description},
 212                                 );
 213         }
 214
 215         xml_out(\%data,
 216                 NoAttr          => 1,
 217                 NumericEscape   => 2,
 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_number
 256                         Date                    date
 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         # Completely undocumented field that sometimes override <Verbiage>
 267         $self->error_message($response->{Error}) if $response->{Error};
 268
 269         $self->card_type(CARD_TYPES->{$self->card_type});
 270
 271         $self->{products_raw} = $response->{Products};
 272
 273         return $self;
 274 }
 275
 276 sub submit {
 277         my ($self) = @_;
 278
 279         croak "Missing required argument 'merchant_id'"
 280                 unless defined $self->{merchant_id};
 281
 282         my ($page, $response, %headers) =
 283                 post_https(
 284                                 $self->server,
 285                                 $self->port,
 286                                 $self->path,
 287                                 undef,
 288                                 make_form(
 289                                         xxxRequestMode => 'X',
 290                                         xxxRequestData => $self->to_xml,
 291                                 )
 292                         );
 293
 294         croak 'Error connecting to server' unless $page;
 295         croak 'Server responded, but not in XML' unless $page =~ /^<\?xml/;
 296
 297         $self->parse_response($page);
 298 }
 299
 300
 301 1;
 302
 303 __END__
 304
 305
 306 =head1 NAME
 307
 308 Business::OnlinePayment::InternetSecure - InternetSecure backend for Business::OnlinePayment
 309
 310 =head1 SYNOPSIS
 311
 312   use Business::OnlinePayment;
 313
 314   $txn = new Business::OnlinePayment 'InternetSecure',
 315                                         merchant_id => '0000';
 316
 317   $txn->content(
 318         action          => 'Normal Authorization',
 319
 320         type            => 'Visa',
 321         card_number     => '0000000000000000',
 322         exp_date        => '2004-07',
 323         cvv2            => '000',               # Optional
 324
 325         name            => "Fr\x{e9}d\x{e9}ric Bri\x{e8}re",
 326         company         => '',
 327         address         => '123 Street',
 328         city            => 'Metropolis',
 329         state           => 'ZZ',
 330         zip             => 'A1A 1A1',
 331         country         => 'CA',
 332         phone           => '(555) 555-1212',
 333         email           => 'fbriere@fbriere.net',
 334
 335         description     => 'Online purchase',
 336         amount          => 49.95,
 337         currency        => 'CAD',
 338         taxes           => 'GST PST',
 339         );
 340
 341   $txn->submit;
 342
 343   if ($txn->is_success) {
 344         print "Card processed successfully: " . $tx->authorization . "\n";
 345   } else {
 346         print "Card was rejected: " . $tx->error_message . "\n";
 347   }
 348
 349 =head1 DESCRIPTION
 350
 351 Business::OnlinePayment::InternetSecure is an implementation of
 352 L<Business::OnlinePayment> that allows for processing online credit card
 353 payments through InternetSecure.
 354
 355 See L<Business::OnlinePayment> for more information about the generic
 356 Business::OnlinePayment interface.
 357
 358 =head1 CREATOR
 359
 360 Object creation is done via L<Business::OnlinePayment>; see its manpage for
 361 details.  The I<merchant_id> processor option is required, and corresponds
 362 to the merchant ID assigned to you by InternetSecure.
 363
 364 =head1 METHODS
 365
 366 (Other methods are also available -- see L<Business::OnlinePayment> for more
 367 details.)
 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 (usually required)
 431
 432 Total amount to be billed, excluding taxes if they are to be added separately
 433 by InternetSecure.
 434
 435 This field is required if B<description> is a string, but should be left
 436 undefined if B<description> contains a list of products instead, as outlined
 437 in L<"Products list syntax">.
 438
 439 =item currency
 440
 441 Currency of all amounts for this order.  This can currently be either
 442 C<CAD> (default) or C<USD>.
 443
 444 =item taxes
 445
 446 Taxes to be added automatically to B<amount> by InternetSecure.
 447
 448 Available taxes are C<GST>, C<PST> and C<HST>.  Multiple taxes can specified
 449 by concatenating them with spaces, such as C<GST HST>.
 450
 451 =item name / company / address / city / state / zip / country / phone / email
 452
 453 Customer information.  B<Country> should be a two-letter code taken from ISO
 454 3166-1.
 455
 456 =back
 457
 458 =back
 459
 460 =head2 After order submission
 461
 462 =over 4
 463
 464 =item receipt_number()
 465
 466 Receipt number of this transaction; this is actually a string, unique to all
 467 InternetSecure transactions.
 468
 469 =item sales_number()
 470
 471 Sales order number of this transaction.  This is a number, unique to each
 472 merchant, which is incremented by 1 each time.
 473
 474 =item date()
 475
 476 Date and time of the transaction.  Format is C<YYYY/MM/DD hh:mm:ss>.
 477
 478 =item total_amount()
 479
 480 Total amount billed for this order, including taxes.
 481
 482 =item card_type()
 483
 484 Type of the credit card used for the submitted order, being one of the
 485 following:
 486
 487 =over 4
 488
 489 =item - Visa
 490
 491 =item - MasterCard
 492
 493 =item - American Express
 494
 495 =item - Discover
 496
 497 =back
 498
 499 =item avs_response() / cvv2_response()
 500
 501 Results of the AVS and CVV2 checks.  See the InternetSecure documentation for
 502 the list of possible values.
 503
 504 =item products_raw()
 505
 506 ...
 507
 508
 509 =back
 510
 511
 512 =head1 NOTES
 513
 514 =head2 Products list syntax
 515
 516 Optionally, the B<description> field of B<content()> can contain a reference
 517 to an array of products, instead of a simple string.  Each element of this
 518 array represents a different product, and must be a reference to a hash with
 519 the following fields:
 520
 521 =over 4
 522
 523 =item amount
 524
 525 Unit price of this product.
 526
 527 =item quantity
 528
 529 Ordered quantity of this product.
 530
 531 =item sku
 532
 533 Internal code for this product.
 534
 535 =item description
 536
 537 Description of this product
 538
 539 =item taxes
 540
 541 Taxes that should be automatically added to this product.  If specified, this
 542 overrides the B<taxes> field passed to B<content()>.
 543
 544 =back
 545
 546 When using a products list, the B<amount> field passed to B<content()> should
 547 be left undefined.
 548
 549
 550 =head2 Character encoding
 551
 552 Since communication to/from InternetSecure is encoded with UTF-8, all Unicode
 553 characters are theoretically available when submitting information via
 554 B<submit()>.  (Further restrictions may be imposed by InternetSecure itself.)
 555
 556 When using non-ASCII characters, all data provided to B<submit()> should either
 557 be in the current native encoding (typically latin-1, unless it was modified
 558 via the C<encoding> pragma), or be decoded via the C<Encode> module.
 559 Conversely, all data returned after calling B<submit()> will be automatically
 560 decoded.
 561
 562
 563 =head1 EXPORT
 564
 565 None by default.
 566
 567
 568 =head1 SEE ALSO
 569
 570 L<Business::OnlinePayment>
 571
 572 =head1 AUTHOR
 573
 574 Frédéric Brière, E<lt>fbriere@fbriere.netE<gt>
 575
 576 =head1 COPYRIGHT AND LICENSE
 577
 578 Copyright (C) 2006 by Frédéric Brière
 579
 580 This library is free software; you can redistribute it and/or modify
 581 it under the same terms as Perl itself, either Perl version 5.8.4 or,
 582 at your option, any later version of Perl 5 you may have available.
 583
 584
 585 =cut