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