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