eSelectPlus.pm

   1 package Business::OnlinePayment::eSelectPlus;
   2
   3 use strict;
   4 use Carp;
   5 use Tie::IxHash;
   6 use Business::OnlinePayment 3;
   7 use Business::OnlinePayment::HTTPS 0.03;
   8 use vars qw($VERSION $DEBUG @ISA);
   9
  10 @ISA = qw(Business::OnlinePayment::HTTPS);
  11 $VERSION = '0.08_02';
  12 $DEBUG = 0;
  13
  14 sub set_defaults {
  15     my $self = shift;
  16     my %opts = @_;
  17
  18     #USD
  19     #$self->server('esplusqa.moneris.com');  # development
  20     $self->server('esplus.moneris.com');   # production
  21     $self->path('/gateway_us/servlet/MpgRequest');
  22
  23     ##CAD
  24     ##$self->server('esqa.moneris.com');  # development
  25     #$self->server('www3.moneris.com');   # production
  26     #$self->path('/gateway2/servlet/MpgRequest');
  27
  28     $self->port('443');
  29
  30     $self->build_subs(qw( order_number avs_code skip_avs skip_cvv ));
  31     # avs_code order_type md5 cvv2_response cavv_response
  32
  33     $self->skip_avs( $opts{skip_avs} );
  34     $self->skip_cvv( $opts{skip_cvv} );
  35 }
  36
  37 sub submit {
  38     my($self) = @_;
  39
  40     if ( defined( $self->{_content}{'currency'} )
  41               &&  $self->{_content}{'currency'} eq 'CAD' ) {
  42       $self->server('www3.moneris.com');
  43       $self->path('/gateway2/servlet/MpgRequest');
  44     } else { #sorry, default to USD
  45       $self->server('esplus.moneris.com');
  46       $self->path('/gateway_us/servlet/MpgRequest');
  47     }
  48
  49     if ($self->test_transaction)  {
  50        if ( defined( $self->{_content}{'currency'} )
  51                  &&  $self->{_content}{'currency'} eq 'CAD' ) {
  52          $self->server('esqa.moneris.com');
  53          $self->{_content}{'login'} = 'store2';   # store[123]
  54          $self->{_content}{'password'} = 'yesguy';
  55        } else { #sorry, default to USD
  56          $self->server('esplusqa.moneris.com');
  57          $self->{_content}{'login'} = 'monusqa002';   # monusqa00[123]
  58          $self->{_content}{'password'} = 'qatoken';
  59        }
  60     }
  61
  62     my %cust_id = ( 'invoice_number' => 'cust_id' );
  63
  64     my $invoice_number = $self->{_content}{invoice_number};
  65
  66     # BOP field => eSelectPlus field
  67     #$self->map_fields();
  68     $self->remap_fields(
  69         #                => 'order_type',
  70         #                => 'transaction_type',
  71         #login            => 'store_id',
  72         #password         => 'api_token',
  73
  74         #authorization   =>
  75         #name            =>
  76         #first_name      =>
  77         #last_name       =>
  78         #company         =>
  79         #address         => 'avs_street_number'/'avs_street_name' handled below
  80         #city            =>
  81         #state           =>
  82         zip             => 'avs_zipcode',
  83         #country         =>
  84         phone            => 'avs_custphone',
  85         #fax             =>
  86         email            => 'avs_email',
  87         customer_ip      => 'avs_custip',
  88
  89         card_number      => 'pan',
  90         #expiration        => 'expdate', #handled below
  91         cvv2             => 'cvd_value',
  92
  93         'amount'         => 'amount',
  94         customer_id      => 'cust_id',
  95         order_number     => 'order_id',   # must be unique number
  96         authorization    => 'txn_number', # reference to previous trans
  97     );
  98
  99     my $action = $self->{_content}{'action'};
 100     if ( $self->{_content}{'action'} =~ /^\s*normal\s*authorization\s*$/i ) {
 101       $action = 'purchase';
 102     } elsif ( $self->{_content}{'action'} =~ /^\s*authorization\s*only\s*$/i ) {
 103       $action = 'preauth';
 104     } elsif ( $self->{_content}{'action'} =~ /^\s*post\s*authorization\s*$/i ) {
 105       $action = 'completion';
 106     } elsif ( $self->{_content}{'action'} =~ /^\s*void\s*$/i ) {
 107       $action = 'purchasecorrection';
 108     } elsif ( $self->{_content}{'action'} =~ /^\s*credit\s*$/i ) {
 109       if ( $self->{_content}{'authorization'} ) {
 110         $action = 'refund';
 111       } else {
 112         $action = 'ind_refund';
 113       }
 114     }
 115
 116     if ( $action =~ /^(purchase|preauth|ind_refund)$/ ) {
 117
 118       $self->required_fields(qw(
 119         login password amount card_number expiration
 120       ));
 121
 122       #cardexpiremonth & cardexpireyear
 123       $self->{_content}{'expiration'} =~ /^(\d+)\D+\d*(\d{2})$/
 124         or croak "unparsable expiration ". $self->{_content}{expiration};
 125       my( $month, $year ) = ( $1, $2 );
 126       $month = '0'. $month if $month =~ /^\d$/;
 127       $self->{_content}{expdate} = $year.$month;
 128
 129       #CVD Indicator
 130       #0 = CVD value is deliberately bypassed or is not provided by the merchant
 131       #1 = CVD value is present.
 132       #2 = CVD value is on the card, but is illegible.
 133       #9 = Cardholder states that the card has no CVD imprint.
 134       $self->{_content}{cvd_indicator} = $self->{_content}{cvd_value} ? 1 : 0;
 135
 136       $self->generate_order_id;
 137
 138       $self->{_content}{order_id} .= '-'. ($invoice_number || 0);
 139
 140       $self->{_content}{amount} = sprintf('%.2f', $self->{_content}{amount} );
 141
 142     } elsif ( $action =~ /^(completion|purchasecorrection|refund)$/ ) {
 143
 144       $self->required_fields(qw(
 145         login password order_number authorization
 146       ));
 147
 148       if ( $action eq 'completion' ) {
 149         $self->{_content}{comp_amount} = delete $self->{_content}{amount};
 150       } elsif ( $action eq 'purchasecorrection' ) {
 151         delete $self->{_content}{amount};
 152       #} elsif ( $action eq 'refund' ) {
 153       }
 154
 155     }
 156
 157     if ( $self->{_content}{address} ) {
 158       my $number = '';
 159       my $name = $self->{_content}{address};
 160       if ( $name =~ s/^\s*(\d+)\w\s+// ) {
 161         $number = $1;
 162       }
 163       $name = substr( $name, 0, 19 - length($number) );
 164       $self->{_content}{avs_street_number} = $number;
 165       $self->{_content}{avs_street_name} = $name;
 166     }
 167
 168     $self->{_content}{avs_zipcode} =~ s/\W//g
 169       if defined $self->{_content}{avs_zipcode};
 170
 171     # E-Commerce Indicator (see eSelectPlus docs)
 172     $self->{_content}{'crypt_type'} ||= 7;
 173
 174     $action = "us_$action"
 175       unless defined( $self->{_content}{'currency'} )
 176                    && $self->{_content}{'currency'} eq 'CAD';
 177
 178     #no, values aren't escaped for XML.  their "mpgClasses.pl" example doesn't
 179     #appear to do so, i dunno
 180     tie my %fields, 'Tie::IxHash', $self->get_fields( $self->fields );
 181     my $post_data =
 182       '<?xml version="1.0"?>'.
 183       '<request>'.
 184       '<store_id>'.  $self->{_content}{'login'}. '</store_id>'.
 185       '<api_token>'. $self->{_content}{'password'}. '</api_token>'.
 186       "<$action>".
 187         join('', map "<$_>$fields{$_}</$_>", keys %fields );
 188
 189     if ( $action =~ /^(purchase|preauth|ind_refund)$/ ) {
 190       tie my %avs_fields, 'Tie::IxHash', $self->get_fields( $self->avs_fields );
 191       $post_data .=
 192           '<avs_info>'.
 193             join('', map "<$_>$avs_fields{$_}</$_>", keys %avs_fields ).
 194           '</avs_info>'
 195        if ! $self->skip_avs && grep $_, values %avs_fields;
 196
 197       tie my %cvd_fields, 'Tie::IxHash', $self->get_fields( $self->cvd_fields );
 198       $post_data .=
 199           '<cvd_info>'.
 200             join('', map "<$_>$cvd_fields{$_}</$_>", keys %cvd_fields ).
 201           '</cvd_info>'
 202         if ! $self->skip_cvv && grep $_, values %cvd_fields;
 203     }
 204
 205     $post_data .=
 206       "</$action>".
 207       '</request>';
 208
 209     warn "POSTING: ".$post_data if $DEBUG > 1;
 210
 211     my( $page, $response, @reply_headers) = $self->https_post( $post_data );
 212
 213     if ($DEBUG > 1) {
 214       my %reply_headers = @reply_headers;
 215       warn join('', map { "  $_ => $reply_headers{$_}\n" } keys %reply_headers)
 216     }
 217
 218     if ($response !~ /^200/)  {
 219         # Connection error
 220         $response =~ s/[\r\n]+/ /g;  # ensure single line
 221         $self->is_success(0);
 222         my $diag_message = $response || "connection error";
 223         die $diag_message;
 224     }
 225
 226     # avs_code - eSELECTplus_Perl_IG.pdf Appendix F
 227     my %avsTable = ('A' => 'A',
 228                     'B' => 'A',
 229                     'C' => 'E',
 230                     'D' => 'Y',
 231                     'G' => '',
 232                     'I' => '',
 233                     'M' => 'Y',
 234                     'N' => 'N',
 235                     'P' => 'Z',
 236                     'R' => 'R',
 237                     'S' => '',
 238                     'U' => 'E',
 239                     'W' => 'Z',
 240                     'X' => 'Y',
 241                     'Y' => 'Y',
 242                     'Z' => 'Z',
 243                     );
 244     my $AvsResultCode = $self->GetXMLProp($page, 'AvsResultCode');
 245     $self->avs_code( defined($AvsResultCode) && exists $avsTable{$AvsResultCode}
 246                          ?  $avsTable{$AvsResultCode}
 247                          :  $AvsResultCode
 248                    );
 249
 250     #md5 cvv2_response cavv_response ...?
 251
 252     $self->server_response($page);
 253
 254     my $result = $self->GetXMLProp($page, 'ResponseCode');
 255
 256     die "gateway error: ". $self->GetXMLProp( $page, 'Message' )
 257       if $result =~ /^null$/i;
 258
 259     # Original order_id supplied to the gateway
 260     $self->order_number($self->GetXMLProp($page, 'ReceiptId'));
 261
 262     # We (Whizman & DonorWare) do not have enough info about "ISO"
 263     # response codes to make use of them.
 264     # There may be good reasons why the ISO codes could be preferable,
 265     # but we would need more information.  For now, the ResponseCode.
 266     # $self->result_code( $self->GetXMLProp( $page, 'ISO' ) );
 267     $self->result_code( $result );
 268
 269     if ( $result =~ /^\d+$/ && $result < 50 ) {
 270         $self->is_success(1);
 271         $self->authorization($self->GetXMLProp($page, 'TransID'));
 272     } elsif ( $result =~ /^\d+$/ ) {
 273         $self->is_success(0);
 274         my $tmp_msg = $self->GetXMLProp( $page, 'Message' );
 275         $tmp_msg =~ s/\s{2,}//g;
 276         $tmp_msg =~ s/[\*\=]//g;
 277         $self->error_message( $tmp_msg );
 278     } else {
 279         die "unparsable response received from gateway (response $result)".
 280             ( $DEBUG ? ": $page" : '' );
 281     }
 282
 283 }
 284
 285 use vars qw(@oidset);
 286 @oidset = ( 'A'..'Z', '0'..'9' );
 287 sub generate_order_id {
 288     my $self = shift;
 289     #generate an order_id if order_number not passed
 290     unless (    exists ($self->{_content}{order_id})
 291              && defined($self->{_content}{order_id})
 292              && length ($self->{_content}{order_id})
 293            ) {
 294       $self->{_content}{'order_id'} =
 295         join('', map { $oidset[int(rand(scalar(@oidset)))] } (1..23) );
 296     }
 297 }
 298
 299 sub fields {
 300         my $self = shift;
 301
 302         #order is important to this processor
 303         qw(
 304           order_id
 305           cust_id
 306           amount
 307           comp_amount
 308           txn_number
 309           pan
 310           expdate
 311           crypt_type
 312           cavv
 313         );
 314 }
 315
 316 sub avs_fields {
 317         my $self = shift;
 318
 319         #order is important to this processor
 320         qw(
 321           avs_street_number
 322           avs_street_name
 323           avs_zipcode
 324           avs_email
 325           avs_hostname
 326           avs_browser
 327           avs_shiptocountry
 328           avs_shipmethod
 329           avs_merchprodsku
 330           avs_custip
 331           avs_custphone
 332         );
 333 }
 334
 335 sub cvd_fields {
 336         my $self = shift;
 337
 338         #order is important to this processor
 339         qw(
 340           cvd_indicator
 341           cvd_value
 342         );
 343 }
 344
 345 sub GetXMLProp {
 346         my( $self, $raw, $prop ) = @_;
 347         local $^W=0;
 348
 349         my $data;
 350         ($data) = $raw =~ m"<$prop>(.*?)</$prop>"gsi;
 351         #$data =~ s/<.*?>/ /gs;
 352         chomp $data;
 353         return $data;
 354 }
 355
 356 1;
 357
 358 __END__
 359
 360 =head1 NAME
 361
 362 Business::OnlinePayment::eSelectPlus - Moneris eSelect Plus backend module for Business::OnlinePayment
 363
 364 =head1 SYNOPSIS
 365
 366   use Business::OnlinePayment;
 367
 368   ####
 369   # One step transaction, the simple case.
 370   ####
 371
 372   my $tx = new Business::OnlinePayment("eSelectPlus");
 373   $tx->content(
 374       type           => 'VISA',
 375       login          => 'eSelect Store ID,
 376       password       => 'eSelect API Token',
 377       action         => 'Normal Authorization',
 378       description    => 'Business::OnlinePayment test',
 379       amount         => '49.95',
 380       currency       => 'USD', #or CAD for compatibility with previous releases
 381       name           => 'Tofu Beast',
 382       address        => '123 Anystreet',
 383       city           => 'Anywhere',
 384       state          => 'UT',
 385       zip            => '84058',
 386       phone          => '420-867-5309',
 387       email          => 'tofu.beast@example.com',
 388       card_number    => '4005550000000019',
 389       expiration     => '08/06',
 390       cvv2           => '1234', #optional
 391   );
 392   $tx->submit();
 393
 394   if($tx->is_success()) {
 395       print "Card processed successfully: ".$tx->authorization."\n";
 396   } else {
 397       print "Card was rejected: ".$tx->error_message."\n";
 398   }
 399   print "AVS code: ". $tx->avs_code. "\n"; # Y - Address and ZIP match
 400                                            # A - Address matches but not ZIP
 401                                            # Z - ZIP matches but not address
 402                                            # N - no match
 403                                            # E - AVS error or unsupported
 404                                            # R - Retry (timeout)
 405                                            # (empty) - not verified
 406
 407 =head1 SUPPORTED TRANSACTION TYPES
 408
 409 =head2 CC, Visa, MasterCard, American Express, Discover
 410
 411 Content required: type, login, password, action, amount, card_number, expiration.
 412
 413 =head1 PREREQUISITES
 414
 415   URI::Escape
 416   Tie::IxHash
 417
 418   Net::SSLeay _or_ ( Crypt::SSLeay and LWP )
 419
 420 =head1 DESCRIPTION
 421
 422 For detailed information see L<Business::OnlinePayment>.
 423
 424 =head1 NOTES
 425
 426 =head2 Note for Canadian merchants upgrading to 0.03
 427
 428 As of version 0.03, this module now defaults to the US Moneris.  Make sure to
 429 pass currency=>'CAD' for Canadian transactions.
 430
 431 =head2 Note for upgrading to 0.05
 432
 433 As of version 0.05, the bank authorization code is discarded (AuthCode),
 434 so that authorization() and order_number() can return the 2 fields needed
 435 for capture.  See also
 436 cpansearch.perl.org/src/IVAN/Business-OnlinePayment-3.02/notes_for_module_writers_v3
 437
 438 =head2 Note for upgrading to 0.08 without AVS/CVV enabled with Moneris
 439
 440 This version now passes AVS and CVV info (previous versions did not).  If your
 441 Moneris account is not enabled for these services, you can omit them by passing
 442 the "skip_avs" and/or "skip_cvv" options set to a true value:
 443
 444   my $tx = new Business::OnlinePayment('eSelectPlus',
 445                                          'skip_avs' => 1,
 446                                          'skip_cvv' => 1,
 447                                       );
 448
 449 =head1 AUTHOR
 450
 451 Ivan Kohler <ivan-eselectplus@420.am>
 452 Randall Whitman L<whizman.com|http://whizman.com>
 453
 454 =head1 SEE ALSO
 455
 456 perl(1). L<Business::OnlinePayment>.
 457
 458 =cut
 459