fix voids
[Business-OnlinePayment-eSelectPlus.git] / 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.04';
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     # BOP field => eSelectPlus field
59     #$self->map_fields();
60     $self->remap_fields(
61         #                => 'order_type',
62         #                => 'transaction_type',
63         #login            => 'store_id',
64         #password         => 'api_token',
65         #authorization   => 
66         #customer_ip     =>
67         #name            =>
68         #first_name      =>
69         #last_name       =>
70         #company         =>
71         #address         => 
72         #city            => 
73         #state           => 
74         #zip             => 
75         #country         =>
76         phone            => 
77         #fax             =>
78         email            =>
79         card_number      => 'pan',
80         #expiration        =>
81         #                => 'expdate',
82
83         'amount'         => 'amount',
84         invoice_number   => 'cust_id',
85         #customer_id      => 'cust_id',
86         order_number     => 'order_id',   # must be unique number
87         authorization    => 'txn_number'  # reference to previous trans
88
89         #cvv2              =>
90     );
91
92     my $action = $self->{_content}{'action'};
93     if ( $self->{_content}{'action'} =~ /^\s*normal\s*authorization\s*$/i ) {
94       $action = 'purchase';
95     } elsif ( $self->{_content}{'action'} =~ /^\s*authorization\s*only\s*$/i ) {
96       $action = 'preauth';
97     } elsif ( $self->{_content}{'action'} =~ /^\s*post\s*authorization\s*$/i ) {
98       $action = 'completion';
99     } elsif ( $self->{_content}{'action'} =~ /^\s*void\s*$/i ) {
100       $action = 'purchasecorrection';
101     } elsif ( $self->{_content}{'action'} =~ /^\s*credit\s*$/i ) {
102       if ( $self->{_content}{'authorization'} ) {
103         $action = 'refund';
104       } else {
105         $action = 'ind_refund';
106       }
107     }
108
109     if ( $action =~ /^(purchase|preauth|ind_refund)$/ ) {
110
111       $self->required_fields(
112         qw( login password amount card_number expiration )
113       );
114
115       #cardexpiremonth & cardexpireyear
116       $self->{_content}{'expiration'} =~ /^(\d+)\D+\d*(\d{2})$/
117         or croak "unparsable expiration ". $self->{_content}{expiration};
118       my( $month, $year ) = ( $1, $2 );
119       $month = '0'. $month if $month =~ /^\d$/;
120       $self->{_content}{expdate} = $year.$month;
121
122       $self->generate_order_id;
123
124       $self->{_content}{amount} = sprintf('%.2f', $self->{_content}{amount} );
125
126     } elsif ( $action eq 'completion' || $action eq 'purchasecorrection' ) {
127
128       $self->required_fields( qw( login password order_number authorization ) );
129
130     } elsif ( $action eq 'refund' ) {
131
132       $self->required_fields(
133         qw( login password order_number authorization )
134       );
135
136     }
137
138     # E-Commerce Indicator (see eSelectPlus docs)
139     $self->{_content}{'crypt_type'} ||= 7;
140
141     $action = "us_$action"
142       unless defined( $self->{_content}{'currency'} )
143                    && $self->{_content}{'currency'} eq 'CAD';
144
145     #no, values aren't escaped for XML.  their "mpgClasses.pl" example doesn't
146     #appear to do so, i dunno
147     tie my %fields, 'Tie::IxHash', $self->get_fields( $self->fields );
148     my $post_data =
149       '<?xml version="1.0"?>'.
150       '<request>'.
151       '<store_id>'.  $self->{_content}{'login'}. '</store_id>'.
152       '<api_token>'. $self->{_content}{'password'}. '</api_token>'.
153       "<$action>".
154       join('', map "<$_>$fields{$_}</$_>", keys %fields ).
155       "</$action>".
156       '</request>';
157
158     warn "POSTING: ".$post_data if $DEBUG > 1;
159
160     my( $page, $response, @reply_headers) = $self->https_post( $post_data );
161
162     #my %reply_headers = @reply_headers;
163     #warn join('', map { "  $_ => $reply_headers{$_}\n" } keys %reply_headers )
164     #  if $DEBUG;
165
166     if ($response !~ /^200/)  {
167         # Connection error
168         $response =~ s/[\r\n]+/ /g;  # ensure single line
169         $self->is_success(0);
170         my $diag_message = $response || "connection error";
171         die $diag_message;
172
173     }
174
175     # avs_code - eSELECTplus_Perl_IG.pdf Appendix F
176     my %avsTable = ('A' => 'A',
177                     'B' => 'A',
178                     'C' => 'E',
179                     'D' => 'Y',
180                     'G' => '',
181                     'I' => '',
182                     'M' => 'Y',
183                     'N' => 'N',
184                     'P' => 'Z',
185                     'R' => 'R',
186                     'S' => '',
187                     'U' => 'E',
188                     'W' => 'Z',
189                     'X' => 'Y',
190                     'Y' => 'Y',
191                     'Z' => 'Z',
192                     );
193     my $AvsResultCode = $self->GetXMLProp($page, 'AvsResultCode');
194     $self->avs_code( defined($AvsResultCode) && exists $avsTable{$AvsResultCode}
195                          ?  $avsTable{$AvsResultCode}
196                          :  $AvsResultCode
197                    );
198
199     #md5 cvv2_response cavv_response ...?
200
201     $self->server_response($page);
202
203     my $result = $self->GetXMLProp($page, 'ResponseCode');
204
205     die "gateway error: ". $self->GetXMLProp( $page, 'Message' )
206       if $result =~ /^null$/i;
207
208     # New unique reference created by the gateway
209     $self->order_number($self->GetXMLProp($page, 'ReferenceNum'));
210     # Original order_id supplied to the gateway
211     #$self->order_number($self->GetXMLProp($page, 'ReceiptId'));
212
213     # We (Whizman & DonorWare) do not have enough info about "ISO"
214     # response codes to make use of them.
215     # There may be good reasons why the ISO codes could be preferable,
216     # but we would need more information.  For now, the ResponseCode.
217     # $self->result_code( $self->GetXMLProp( $page, 'ISO' ) );
218     $self->result_code( $result );
219
220     if ( $result =~ /^\d+$/ && $result < 50 ) {
221         $self->is_success(1);
222         $self->authorization($self->GetXMLProp($page, 'AuthCode'));
223     } elsif ( $result =~ /^\d+$/ ) {
224         $self->is_success(0);
225         my $tmp_msg = $self->GetXMLProp( $page, 'Message' );
226         $tmp_msg =~ s/\s{2,}//g;
227         $tmp_msg =~ s/[\*\=]//g;
228         $self->error_message( $tmp_msg );
229     } else {
230         die "unparsable response received from gateway (response $result)".
231             ( $DEBUG ? ": $page" : '' );
232     }
233
234 }
235
236 use vars qw(@oidset);
237 @oidset = ( 'A'..'Z', '0'..'9' );
238 sub generate_order_id {
239     my $self = shift;
240     #generate an order_id if order_number not passed
241     unless (    exists ($self->{_content}{order_id})
242              && defined($self->{_content}{order_id})
243              && length ($self->{_content}{order_id})
244            ) {
245       $self->{_content}{'order_id'} =
246         join('', map { $oidset[int(rand(scalar(@oidset)))] } (1..23) );
247     }
248 }
249
250 sub fields {
251         my $self = shift;
252
253         #order is important to this processor
254         qw(
255           order_id
256           cust_id
257           amount
258           comp_amount
259           txn_number
260           pan
261           expdate
262           crypt_type
263           cavv
264         );
265 }
266
267 sub GetXMLProp {
268         my( $self, $raw, $prop ) = @_;
269         local $^W=0;
270
271         my $data;
272         ($data) = $raw =~ m"<$prop>(.*?)</$prop>"gsi;
273         #$data =~ s/<.*?>/ /gs;
274         chomp $data;
275         return $data;
276 }
277
278 1;
279
280 __END__
281
282 =head1 NAME
283
284 Business::OnlinePayment::eSelectPlus - Moneris eSelect Plus backend module for Business::OnlinePayment
285
286 =head1 SYNOPSIS
287
288   use Business::OnlinePayment;
289
290   ####
291   # One step transaction, the simple case.
292   ####
293
294   my $tx = new Business::OnlinePayment("eSelectPlus");
295   $tx->content(
296       type           => 'VISA',
297       login          => 'eSelect Store ID,
298       password       => 'eSelect API Token',
299       action         => 'Normal Authorization',
300       description    => 'Business::OnlinePayment test',
301       amount         => '49.95',
302       currency       => 'USD', #or CAD for compatibility with previous releases
303       name           => 'Tofu Beast',
304       address        => '123 Anystreet',
305       city           => 'Anywhere',
306       state          => 'UT',
307       zip            => '84058',
308       phone          => '420-867-5309',
309       email          => 'tofu.beast@example.com',
310       card_number    => '4005550000000019',
311       expiration     => '08/06',
312       cvv2           => '1234', #optional
313   );
314   $tx->submit();
315
316   if($tx->is_success()) {
317       print "Card processed successfully: ".$tx->authorization."\n";
318   } else {
319       print "Card was rejected: ".$tx->error_message."\n";
320   }
321   print "AVS code: ". $tx->avs_code. "\n"; # Y - Address and ZIP match
322                                            # A - Address matches but not ZIP
323                                            # Z - ZIP matches but not address
324                                            # N - no match
325                                            # E - AVS error or unsupported
326                                            # R - Retry (timeout)
327                                            # (empty) - not verified
328
329 =head1 SUPPORTED TRANSACTION TYPES
330
331 =head2 CC, Visa, MasterCard, American Express, Discover
332
333 Content required: type, login, password, action, amount, card_number, expiration.
334
335 =head1 PREREQUISITES
336
337   URI::Escape
338   Tie::IxHash
339
340   Net::SSLeay _or_ ( Crypt::SSLeay and LWP )
341
342 =head1 DESCRIPTION
343
344 For detailed information see L<Business::OnlinePayment>.
345
346 =head1 Note for Canadian merchants upgrading to 0.03
347
348 As of version 0.03, this module now defaults to the US Moneris.  Make sure to
349 pass currency=>'CAD' for Canadian transactions.
350
351 =head1 AUTHOR
352
353 Ivan Kohler <ivan-eselectplus@420.am>
354 Randall Whitman <www.whizman.com>
355
356 =head1 SEE ALSO
357
358 perl(1). L<Business::OnlinePayment>.
359
360 =cut
361