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