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 get_fields now filters out undefs in 3.x. :(
  47 #
  48 sub get_fields {
  49         my ($self, @fields) = @_;
  50
  51         my %content = $self->content;
  52
  53         my %new = map +($_ => $content{$_}), @fields;
  54
  55         return %new;
  56 }
  57
  58 # OnlinePayment's remap_fields is buggy, so we simply rewrite it
  59 #
  60 sub remap_fields {
  61         my ($self, %map) = @_;
  62
  63         my %content = $self->content();
  64         foreach (keys %map) {
  65                 $content{$map{$_}} = delete $content{$_};
  66         }
  67         $self->content(%content);
  68 }
  69
  70 # Combine get_fields and remap_fields for convenience
  71 #
  72 sub get_remap_fields {
  73         my ($self, %map) = @_;
  74
  75         $self->remap_fields(reverse %map);
  76         my %data = $self->get_fields(keys %map);
  77
  78         return %data;
  79 }
  80
  81 # Since there's no standard format for expiration dates, we try to do our best
  82 #
  83 sub parse_expdate {
  84         my ($self, $str) = @_;
  85
  86         local $_ = $str;
  87
  88         my ($y, $m);
  89
  90         if (/^(\d{4})\W(\d{1,2})$/ ||           # YYYY.MM  or  YYYY-M
  91                         /^(\d\d)\W(\d)$/ ||     # YY/M  or  YY-M
  92                         /^(\d\d)[.-](\d\d)$/) { # YY-MM
  93                 ($y, $m) = ($1, $2);
  94         } elsif (/^(\d{1,2})\W(\d{4})$/ ||      # MM-YYYY  or  M/YYYY
  95                         /^(\d)\W(\d\d)$/ ||     # M/YY  or  M-YY
  96                         /^(\d\d)\/?(\d\d)$/) {  # MM/YY  or  MMYY
  97                 ($y, $m) = ($2, $1);
  98         } else {
  99                 croak "Unable to parse expiration date: $str";
 100         }
 101
 102         $y += 2000 if $y < 2000;  # Aren't we glad Y2K is behind us?
 103
 104         return ($y, $m);
 105 }
 106
 107 # Convert a single product into a product string
 108 #
 109 sub prod_string {
 110         my ($self, $currency, $taxes, %data) = @_;
 111
 112         croak "Missing amount in product" unless defined $data{amount};
 113
 114         my @flags = ($currency);
 115
 116         $taxes = uc $data{taxes} if defined $data{taxes};
 117         foreach (split ' ' => $taxes) {
 118                 croak "Unknown tax code $_" unless /^(GST|PST|HST)$/;
 119                 push @flags, $_;
 120         }
 121
 122         if ($self->test_transaction) {
 123                 push @flags, $self->test_transaction < 0 ? 'TESTD' : 'TEST';
 124         }
 125
 126         return join '::' =>
 127                                 sprintf('%.2f' => $data{amount}),
 128                                 $data{quantity} || 1,
 129                                 _esc _def $data{sku},
 130                                 _esc _def $data{description},
 131                                 join('' => map "{$_}" => @flags),
 132                                 ;
 133 }
 134
 135 # Generate the XML document for this transaction
 136 #
 137 sub to_xml {
 138         my ($self) = @_;
 139
 140         my %content = $self->content;
 141
 142         $self->required_fields(qw(action card_number exp_date));
 143
 144         croak 'Unsupported transaction type'
 145                 if $content{type} && $content{type} !~
 146                         /^(Visa|MasterCard|American Express|Discover)$/i;
 147
 148         croak 'Unsupported action'
 149                 unless $content{action} =~ /^Normal Authori[zs]ation$/i;
 150
 151         $content{currency} ||= 'CAD';
 152         $content{currency} = uc $content{currency};
 153         croak "Unknown currency code ", $content{currency}
 154                 unless $content{currency} =~ /^(CAD|USD)$/;
 155
 156         $content{taxes} ||= '';
 157         $content{taxes} = uc $content{taxes};
 158
 159         my %data = $self->get_remap_fields(qw(
 160                         xxxCard_Number          card_number
 161
 162                         xxxName                 name
 163                         xxxCompany              company
 164                         xxxAddress              address
 165                         xxxCity                 city
 166                         xxxProvince             state
 167                         xxxPostal               zip
 168                         xxxCountry              country
 169                         xxxPhone                phone
 170                         xxxEmail                email
 171
 172                         xxxShippingName         ship_name
 173                         xxxShippingCompany      ship_company
 174                         xxxShippingAddress      ship_address
 175                         xxxShippingCity         ship_city
 176                         xxxShippingProvince     ship_state
 177                         xxxShippingPostal       ship_zip
 178                         xxxShippingCountry      ship_country
 179                         xxxShippingPhone        ship_phone
 180                         xxxShippingEmail        ship_email
 181                 ));
 182
 183         $data{MerchantNumber} = $self->merchant_id;
 184
 185         $data{xxxCard_Number} =~ tr/ //d;
 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                                                         $content{taxes},
 203                                                         %$_),
 204                                                 @{ $content{description} };
 205         } else {
 206                 $self->required_fields(qw(amount));
 207                 $data{Products} = $self->prod_string(
 208                                         $content{currency},
 209                                         $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_order_number
 255                         xxxName                 cardholder
 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         $self->card_type(CARD_TYPES->{$self->card_type});
 266
 267         $self->{products_raw} = $response->{Products};
 268
 269         return $self;
 270 }
 271
 272 sub submit {
 273         my ($self) = @_;
 274
 275         croak "Missing required argument 'merchant_id'"
 276                 unless defined $self->{merchant_id};
 277
 278         my ($page, $response, %headers) =
 279                 post_https(
 280                                 $self->server,
 281                                 $self->port,
 282                                 $self->path,
 283                                 undef,
 284                                 make_form(
 285                                         xxxRequestMode => 'X',
 286                                         xxxRequestData => Encode::encode_utf8(
 287                                                                 $self->to_xml
 288                                                           ),
 289                                 )
 290                         );
 291
 292         croak 'Error connecting to server' unless $page;
 293         croak 'Server responded, but not in XML' unless $page =~ /^<\?xml/;
 294
 295         $self->parse_response($page);
 296 }
 297
 298
 299 1;
 300
 301 __END__
 302
 303
 304 =head1 NAME
 305
 306 Business::OnlinePayment::InternetSecure - InternetSecure backend for Business::OnlinePayment
 307
 308 =head1 SYNOPSIS
 309
 310   use Business::OnlinePayment;
 311
 312   $txn = new Business::OnlinePayment 'InternetSecure',
 313                                         merchant_id => '0000';
 314
 315   $txn->content(
 316         action          => 'Normal Authorization',
 317
 318         type            => 'Visa',
 319         card_number     => '0000000000000000',
 320         exp_date        => '2004-07',
 321         cvv2            => '000',               # Optional
 322
 323         name            => "Fr\x{e9}d\x{e9}ric Bri\x{e8}re",
 324         company         => '',
 325         address         => '123 Street',
 326         city            => 'Metropolis',
 327         state           => 'ZZ',
 328         zip             => 'A1A 1A1',
 329         country         => 'CA',
 330         phone           => '(555) 555-1212',
 331         email           => 'fbriere@fbriere.net',
 332
 333         description     => 'Online purchase',
 334         amount          => 49.95,
 335         currency        => 'CAD',
 336         taxes           => 'GST PST',
 337         );
 338
 339   $txn->submit;
 340
 341   if ($txn->is_success) {
 342         print "Card processed successfully: " . $tx->authorization . "\n";
 343   } else {
 344         print "Card was rejected: " . $tx->error_message . "\n";
 345   }
 346
 347 =head1 DESCRIPTION
 348
 349 Business::OnlinePayment::InternetSecure is an implementation of
 350 L<Business::OnlinePayment> that allows for processing online credit card
 351 payments through InternetSecure.
 352
 353 See L<Business::OnlinePayment> for more information about the generic
 354 Business::OnlinePayment interface.
 355
 356 =head1 CREATOR
 357
 358 Object creation is done via L<Business::OnlinePayment>; see its manpage for
 359 details.  The I<merchant_id> processor option is required, and corresponds
 360 to the merchant ID assigned to you by InternetSecure.
 361
 362 =head1 METHODS
 363
 364 (See L<Business::OnlinePayment> for more methods.)
 365
 366 =head2 Before order submission
 367
 368 =over 4
 369
 370 =item content( CONTENT )
 371
 372 Sets up the data prior to a transaction (overwriting any previous data by the
 373 same occasion).  CONTENT is an associative array (hash), containing some of
 374 the following fields:
 375
 376 =over 4
 377
 378 =item action (required)
 379
 380 What to do with the transaction.  Only C<Normal Authorization> is supported
 381 for the moment.
 382
 383 =item type
 384
 385 Transaction type, being one of the following:
 386
 387 =over 4
 388
 389 =item - Visa
 390
 391 =item - MasterCard
 392
 393 =item - American Express
 394
 395 =item - Discover
 396
 397 =back
 398
 399 (This is actually ignored for the moment, and can be left blank or undefined.)
 400
 401 =item card_number (required)
 402
 403 Credit card number.  Spaces are allowed, and will be automatically removed.
 404
 405 =item exp_date (required)
 406
 407 Credit card expiration date.  Since L<Business::OnlinePayment> does not specify
 408 any syntax, this module is rather lax regarding what it will accept.  The
 409 recommended syntax is I<YYYY-MM>, but forms such as I<MM/YYYY> or I<MMYY> are
 410 allowed as well.
 411
 412 =item cvv2
 413
 414 Three- or four-digit verification code printed on the card.  This can be left
 415 blank or undefined, in which case no check will be performed.  Whether or not a
 416 transaction will be declined in case of a mismatch depends on the merchant
 417 account configuration.
 418
 419 This number may be called Card Verification Value (CVV2), Card Validation
 420 Code (CVC2) or Card Identification number (CID), depending on the card issuer.
 421
 422 =item description
 423
 424 A short description of the purchase.  See L<"Products list syntax"> for
 425 an alternate syntax that allows a list of products to be specified.
 426
 427 =item amount
 428
 429 Total amount to be billed, excluding taxes if they are to be added separately.
 430 This field is required if B<description> is a string, and should be left
 431 undefined if B<description> contains a list of products, as outlined in
 432 L<"Products list syntax">.
 433
 434 =item currency
 435
 436 Currency of all amounts for this order.  This can currently be either
 437 C<CAD> (default) or C<USD>.
 438
 439 =item taxes
 440
 441 Taxes to be added automatically.  These should not be included in B<amount>;
 442 they will be automatically added by InternetSecure later on.
 443
 444 Available taxes are C<GST>, C<PST> and C<HST>.  Taxes can be combined by
 445 separating them with spaces, such as C<GST HST>.
 446
 447 =item name / company / address / city / state / zip / country / phone / email
 448
 449 Facultative customer information.  B<state> should be either a postal
 450 abbreviation or a two-letter code taken from ISO 3166-2, and B<country> should
 451 be a two-letter code taken from ISO 3166-1.
 452
 453 =back
 454
 455 =back
 456
 457 =head2 After order submission
 458
 459 =over 4
 460
 461 =item receipt_number() / sales_order_number()
 462
 463 Receipt number and sales order number of submitted order.
 464
 465 =item total_amount()
 466
 467 Total amount billed for this order, including taxes.
 468
 469 =item cardholder()
 470
 471 Cardholder's name.  This is currently a mere copy of the B<name> field passed
 472 to B<submit()>.
 473
 474 =item card_type()
 475
 476 Type of the credit card used for the submitted order, being one of the
 477 following:
 478
 479 =over 4
 480
 481 =item - Visa
 482
 483 =item - MasterCard
 484
 485 =item - American Express
 486
 487 =item - Discover
 488
 489 =back
 490
 491 =item avs_response() / cvv2_response()
 492
 493 Results of the AVS and CVV2 checks.  See the InternetSecure documentation for
 494 the list of possible values.
 495
 496 =item products_raw()
 497
 498 ...
 499
 500
 501 =back
 502
 503
 504 =head1 NOTES
 505
 506 =head2 Products list syntax
 507
 508 Optionally, the B<description> field of B<content()> can contain a reference
 509 to an array of products, instead of a simple string.  Each element of this
 510 array represents a different product, and must be a reference to a hash with
 511 the following fields:
 512
 513 =over 4
 514
 515 =item amount
 516
 517 Unit price of this product.
 518
 519 =item quantity
 520
 521 Ordered quantity of this product.  This can be a decimal value.
 522
 523 =item sku
 524
 525 Internal code for this product.
 526
 527 =item description
 528
 529 Description of this product
 530
 531 =item taxes
 532
 533 Taxes that should be automatically added to this product.  If specified, this
 534 overrides the B<taxes> field passed to B<content()>.
 535
 536 =back
 537
 538 When using a products list, the B<amount> field passed to B<content()> should
 539 be left undefined.
 540
 541
 542 =head2 Character encoding
 543
 544 Since communication to/from InternetSecure is encoded with UTF-8, all Unicode
 545 characters are theoretically available when submitting information via
 546 B<submit()>.  (Further restrictions may be imposed by InternetSecure itself.)
 547
 548 When using non-ASCII characters, all data provided to B<submit()> should either
 549 be in the current native encoding (typically latin-1, unless it was modified
 550 via the C<encoding> pragma), or be decoded via the C<Encode> module.
 551 Conversely, all data returned after calling B<submit()> will be automatically
 552 decoded.
 553
 554
 555 =head1 EXPORT
 556
 557 None by default.
 558
 559
 560 =head1 SEE ALSO
 561
 562 L<Business::OnlinePayment>
 563
 564 =head1 AUTHOR
 565
 566 Frédéric Brière, E<lt>fbriere@fbriere.netE<gt>
 567
 568 =head1 COPYRIGHT AND LICENSE
 569
 570 Copyright (C) 2006 by Frédéric Brière
 571
 572 This library is free software; you can redistribute it and/or modify
 573 it under the same terms as Perl itself, either Perl version 5.8.4 or,
 574 at your option, any later version of Perl 5 you may have available.
 575
 576
 577 =cut