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