File Coverage

blib/lib/Business/OnlinePayment/Skipjack.pm
Criterion Covered Total %
statement 57 126 45.2
branch 9 62 14.5
condition 1 15 6.6
subroutine 14 21 66.6
pod 7 14 50.0
total 88 238 36.9


line stmt bran cond sub pod time code
1             ## Business::OnlinePayment::Skipjack
2             ##
3             ## Original Skipjack.pm developed by New York Connect Net (http://nyct.net)
4             ## Michael Bacarella
5             ##
6             ## Modified for GetCareer.com by Slipstream.com
7             ## Troy Davis
8             ##
9             ## 'Adapted' (completely rewritten) for Business::OnlinePayment
10             ## by Fire2Wire Internet Services (http://www.fire2wire.com)
11             ## Mark Wells
12             ## Kristian Hoffmann
13             ## James Switzer
14              
15             ## Required packages:
16             ## Net::SSLeay
17             ## Text::CSV
18             ## Business::OnlinePayment
19              
20              
21             package Business::OnlinePayment::Skipjack;
22              
23 10     10   1640156 use strict;
  10         30  
  10         391  
24 10     10   53 use Carp;
  10         16  
  10         1822  
25 10     10   1866 use Business::OnlinePayment 3;
  10         7151  
  10         225  
26 10     10   15046 use Business::OnlinePayment::HTTPS;
  10         325649  
  10         367  
27 10     10   14194 use Text::CSV_XS;
  10         176291  
  10         7747  
28 10     10   264 use vars qw( @ISA $VERSION $DEBUG );
  10         1402  
  10         35846  
29              
30             $VERSION = "0.5";
31             $DEBUG = 0;
32              
33             @ISA = qw( Business::OnlinePayment::HTTPS );
34              
35             my %CC_ERRORS = (
36             '-1' => 'Invalid length (-1)',
37             '-35' => 'Invalid credit card number (-35)',
38             '-37' => 'Failed communication (-37)',
39             '-39' => 'Serial number is too short (-39)',
40             '-51' => 'The zip code is invalid',
41             '-52' => 'The shipto zip code is invalid',
42             '-53' => 'Length of expiration date (-53)',
43             '-54' => 'Length of account number date (-54)',
44             '-55' => 'Length of street address (-55)',
45             '-56' => 'Length of shipto street address (-56)',
46             '-57' => 'Length of transaction amount (-57)',
47             '-58' => 'Length of name (-58)',
48             '-59' => 'Length of location (-59)',
49             '-60' => 'Length of state (-60)',
50             '-61' => 'Length of shipto state (-61)',
51             '-62' => 'Length of order string (-62)',
52             '-64' => 'Invalid phone number (-64)',
53             '-65' => 'Empty name (-65)',
54             '-66' => 'Empty email (-66)',
55             '-67' => 'Empty street address (-66)',
56             '-68' => 'Empty city (-68)',
57             '-69' => 'Empty state (-69)',
58             '-70' => 'Empty zip code (-70)',
59             '-71' => 'Empty order number (-71)',
60             '-72' => 'Empty account number (-72)',
61             '-73' => 'Empty expiration month (-73)',
62             '-74' => 'Empty expiration year (-74)',
63             '-75' => 'Empty serial number (-75)',
64             '-76' => 'Empty transaction amount (-76)',
65             '-79' => 'Length of customer name (-79)',
66             '-80' => 'Length of shipto customer name (-80)',
67             '-81' => 'Length of customer location (-81)',
68             '-82' => 'Length of customer state (-82)',
69             '-83' => 'Length of shipto phone (-83)',
70             '-84' => 'Pos Error duplicate ordernumber (-84)',
71             '-91' => 'Pos Error CVV2 (-91)',
72             '-92' => 'Pos Error Approval Code (-92)',
73             '-93' => 'Pos Error Blind Credits Not Allowed (-93)',
74             '-94' => 'Pos Error Blind Credits Failed (-94)',
75             '-95' => 'Pos Error Voice Authorizations Not Allowed (-95)',
76             );
77              
78             my %AVS_CODES = (
79             'X' => 'Exact match, 9 digit zip',
80             'Y' => 'Exact match, 5 digit zip',
81             'A' => 'Address match only',
82             'W' => '9 digit match only',
83             'Z' => '5 digit match only',
84             'N' => 'No address or zip match',
85             'U' => 'Address unavailable',
86             'R' => 'Issuer system unavailable',
87             'E' => 'Not a mail/phone order',
88             'S' => 'Service not supported'
89             );
90              
91             my %FIELDS = (
92             name => 'sjname',
93             email => 'Email',
94             address => 'Streetaddress',
95             city => 'City',
96             state => 'State',
97             zip => 'Zipcode',
98             order_number => 'Ordernumber',
99             card_number => 'Accountnumber',
100             exp_month => 'Month',
101             exp_year => 'Year',
102             amount => 'Transactionamount',
103             orderstring => 'Orderstring',
104             phone => 'Shiptophone',
105             login => 'Serialnumber',
106             );
107              
108             my %CHANGE_STATUS_FIELDS = (
109             login => 'szSerialNumber',
110             password => 'szDeveloperSerialNumber',
111             order_number => 'szOrderNumber',
112             # => 'szTransactionId',
113             amount => 'szAmount',
114             );
115              
116             my @CHANGE_STATUS_RESPONSE = (
117             'Serial Number',
118             'Error Code',
119             'NumRecs',
120             #'Reserved',
121             #'Reserved',
122             #'Reserved',
123             #'Reserved',
124             #'Reserved',
125             #'Reserved',
126             #'Reserved',
127             #'Reserved',
128             );
129              
130             my @CHANGE_STATUS_RESPONSE_RECORD = (
131             'Serial Number (Record)',
132             'Amount',
133             'Desired Status',
134             'Status Response',
135             'Status Response Message',
136             'Order Number',
137             'Transaction Id'
138             );
139              
140             my %CHANGE_STATUS_ERROR_CODES = (
141             '0' => 'Success',
142             '-1' => 'Invalid Command',
143             '-2' => 'Parameter Missing',
144             '-3' => 'Failed retrieving response',
145             '-4' => 'Invalid Status',
146             '-5' => 'Failed reading security flags',
147             '-6' => 'Developer serial number not found',
148             '-7' => 'Invalid Serial Number',
149             '-8' => 'Expiration year not four characters',
150             '-9' => 'Credit card expired',
151             '-10' => 'Invalid starting date (recurring payment)',
152             '-11' => 'Failed adding recurring payment',
153             '-12' => 'Invalid frequency (recurring payment)',
154             );
155              
156             my %GET_STATUS_FIELDS = (
157             login => 'szSerialNumber',
158             password => 'szDeveloperSerialNumber',
159             order_number => 'szOrderNumber',
160             #date => 'szDate', # would probably need some massaging
161             # and parse_SJAPI_TransactionStatusRequest would
162             # need to handle multiple records...
163             );
164              
165             my @GET_STATUS_RESPONSE = (
166             'Serial Number',
167             'Error Code',
168             'NumRecs',
169             #'Reserved',
170             #'Reserved',
171             #'Reserved',
172             #'Reserved',
173             #'Reserved',
174             #'Reserved',
175             #'Reserved',
176             #'Reserved',
177             );
178              
179             my @GET_STATUS_RESPONSE_RECORD = (
180             'Serial Number (Record)',
181             'Amount',
182             'Transaction Status Code',
183             'Transaction Status Message',
184             'Order Number',
185             'Transaction Date',
186             'Transaction Id',
187             'Approval Code',
188             'Batch Number',
189             );
190              
191             my %GET_STATUS_ERROR_CODES = (
192             '0' => 'Success',
193             '-1' => 'Invalid Command',
194             '-2' => 'Parameter Missing',
195             '-3' => 'Failed retrieving response',
196             '-4' => 'Invalid Status',
197             '-5' => 'Failed reading security flags',
198             '-6' => 'Developer serial number not found',
199             '-7' => 'Invalid Serial Number',
200             '-8' => 'Expiration year not four characters',
201             '-9' => 'Credit card expired',
202             );
203              
204             my %CUR_STATUS_CODES = (
205             '0' => 'Idle',
206             '1' => 'Authorized',
207             '2' => 'Denied',
208             '3' => 'Settled',
209             '4' => 'Credited',
210             '5' => 'Deleted',
211             '6' => 'Archived',
212             '7' => 'Pre-Auth',
213             );
214              
215             my %PEND_STATUS_CODES = (
216             '0' => 'Idle',
217             '1' => 'Pending Credit',
218             '2' => 'Pending Settlement ',
219             '3' => 'Pending Delete',
220             '4' => 'Pending Authorization',
221             '5' => 'Pending Settle Force (for Manual Accts)',
222             '6' => 'Pending Recurring',
223             );
224              
225 8     8   1077 sub _gen_ordernum { return int(rand(4000000000)); }
226              
227             sub set_defaults
228             {
229 12     12 0 2916 my $self = shift;
230              
231             # For production
232 12         398 $self->server('www.skipjackic.com');
233              
234 12         516 $self->port(443);
235              
236 12         110 return;
237             }
238              
239              
240             sub submit
241             {
242 0     0 1   my $self = shift;
243 0           my %c = $self->content;
244 0           my (%input, %output);
245              
246 0 0         unless ( $c{type} =~ /(cc|visa|mastercard|american express|discover)/i ) {
247 0           croak 'Business::OnlinePayment::Skipjack does not support "' .
248             $c{type}. '" transactions';
249             }
250              
251             # skipjack kicks out "Length of transaction amount (-57)" or "Invalid amount"
252             # if the amount is missing .XX
253 0 0 0       $c{amount} = sprintf('%.2f', $c{amount})
254             if defined($c{amount}) && length($c{amount});
255              
256 0 0         if ( lc($c{action}) eq 'normal authorization' ) {
    0          
    0          
257 0           $self->{_action} = 'normal authorization';
258 0           $self->path('/scripts/evolvcc.dll?AuthorizeAPI');
259              
260 0           $c{expiration} =~ /(\d\d?)\D*(\d\d?)/; # Slightly less crude way to extract the exp date.
261 0           $c{exp_month} = sprintf('%02d',$1);
262 0           $c{exp_year} = sprintf('%02d',$2);
263              
264 0 0         $c{order_number} = _gen_ordernum unless $c{order_number};
265              
266 0 0         $c{orderstring} = '0~'.$c{description}.'~'.$c{amount}.'~1~N~||'
267             unless $c{orderstring};
268              
269 0   0       %input = map { ($FIELDS{$_} || $_), $c{$_} } keys(%c);
  0            
270              
271             } elsif ( $c{action} =~ /^(credit|void|post authorization)$/i ) {
272              
273 0           $self->path('/scripts/evolvcc.dll?SJAPI_TransactionChangeStatusRequest');
274              
275 0   0       %input = map { ($CHANGE_STATUS_FIELDS{$_} || $_), $c{$_} } keys %c;
  0            
276              
277 0 0         if ( lc($c{action} ) eq 'credit' ) {
    0          
    0          
278 0           $self->{_action} = 'credit';
279 0           $input{szDesiredStatus} = 'CREDIT';
280             } elsif ( lc($c{action} ) eq 'void' ) {
281 0           $self->{_action} = 'void';
282 0           $input{szDesiredStatus} = 'DELETE';
283             } elsif ( lc($c{action} ) eq 'post authorization' ) {
284 0           $self->{_action} = 'postauth';
285 0           $input{szDesiredStatus} = 'SETTLE';
286             } else {
287 0           die "fatal: $c{action} is not credit or void!";
288             }
289              
290             } elsif ( lc($c{action}) eq 'status' ) {
291              
292 0           $self->{_action} = 'status';
293 0           $self->path('/scripts/evolvcc.dll?SJAPI_TransactionStatusRequest');
294 0   0       %input = map { ($GET_STATUS_FIELDS{$_} || $_), $c{$_} } keys(%c);
  0            
295              
296             } else {
297              
298 0           croak 'Business::OnlinePayment::Skipjack does not support "'.
299             $c{action}. '" actions';
300              
301             }
302              
303 0 0         $self->server('developer.skipjackic.com') # test mode
304             if $self->test_transaction();
305              
306 0           my( $page, $response ) = $self->https_post( %input );
307 0 0         warn "\n$page\n" if $DEBUG;
308              
309 0 0         if ( $self->{_action} eq 'normal authorization' ) {
    0          
    0          
310 0           %output = parse_Authorize_API($page);
311             } elsif ( $self->{_action} =~ /^(credit|void|postauth)$/ ) {
312 0           %output = parse_SJAPI_TransactionChangeStatusRequest($page);
313             } elsif ( $self->{_action} eq 'status' ) {
314 0           %output = parse_SJAPI_TransactionStatusRequest($page);
315             } else {
316 0           die "fatal: unknown action: ". $self->{_action};
317             }
318              
319 0           $self->{_result} = \%output;
320 0           $self->authorization($output{'AUTHCODE'});
321 0           return;
322             }
323              
324             sub is_success
325             {
326 12     12 1 58 my $self = shift;
327              
328 12 100       84 if ( $self->{_action} eq 'normal authorization' ) {
    100          
    50          
329              
330 8         49 return( $self->{_result}->{'szIsApproved'} == 1 );
331              
332             } elsif ( $self->{_action} =~ /^(credit|void|postauth)$/ ) {
333              
334 3   33     39 return( $self->{_result}{'Error Code'} eq '0' # == 0 matches ''
335             && uc($self->{_result}{'Status Response'}) eq 'SUCCESSFUL'
336             );
337              
338             } elsif ( $self->{_action} eq 'status' ) {
339              
340 1         5 return( $self->{_result}{'Error Code'} eq '0' ); # == 0 matches ''
341              
342             } else {
343 0         0 die "fatal: unknown action: ". $self->{_action};
344             }
345              
346             }
347              
348             sub error_message
349             {
350 0     0 1 0 my $self = shift;
351 0         0 my $r;
352              
353 0 0       0 if($self->is_success) { return ''; }
  0         0  
354              
355 0 0       0 if ( $self->{_action} eq 'normal authorization' ) {
    0          
    0          
356              
357 0 0       0 if(($r = $self->{_result}->{'szReturnCode'}) < 0) { return $CC_ERRORS{$r}; }
  0         0  
358 0 0       0 if($r = $self->{_result}->{'szAVSResponseMessage'}) { return $r; }
  0         0  
359 0 0       0 if($r = $self->{_result}->{'szAuthorizationDeclinedMessage'}) { return $r; }
  0         0  
360              
361             } elsif ( $self->{_action} =~ /^(credit|void|postauth)$/ ) {
362              
363 0 0       0 if ( ( $r = $self->{_result}{'Error Code'} ) < 0 ) {
364 0         0 return $CHANGE_STATUS_ERROR_CODES{$r};
365             } else {
366 0         0 return $self->{_result}{'Status Response Message'};
367             }
368              
369             } elsif ( $self->{_action} eq 'status' ) {
370              
371 0 0       0 if ( ( $r = $self->{_result}{'Error Code'} ) < 0 ) {
372 0         0 return $CHANGE_STATUS_ERROR_CODES{$r};
373             } else {
374 0         0 return $self->{_result}{'Status Response Message'};
375             }
376              
377             } else {
378 0         0 die "fatal: unknown action: ". $self->{_action};
379             }
380              
381             }
382              
383              
384             #sub result_code { shift->{_result}->{'ezIsApproved'}; }
385 12     12 1 45 sub authorization { shift->{_result}{'szAuthorizationResponseCode'}; }
386 0     0 1 0 sub avs_code { shift->{_result}{'szAVSResponseCode'}; }
387 4     4 1 182 sub order_number { shift->{_result}{'szOrderNumber'}; }
388 0     0 1 0 sub cvv2_response { shift->{_result}{'szCVV2ResponseCode'}; }
389 0     0 0 0 sub cavv_response { shift->{_result}{'szCAVVResponseCode'}; }
390              
391             sub status {
392 0     0 0 0 my $self = shift;
393             $CUR_STATUS_CODES{
394 0         0 substr( $self->{_result}{'Transaction Status Code'}, 0, 1 )
395             };
396             }
397              
398             sub pending_status {
399 0     0 0 0 my $self = shift;
400             $PEND_STATUS_CODES{
401 0         0 substr( $self->{_result}{'Transaction Status Code'}, 1, 2 )
402             };
403             }
404              
405             sub parse_Authorize_API
406             {
407              
408 8     8 0 19 my $page = shift;
409 8         18 my %output;
410 8         87 my $csv_keys = new Text::CSV_XS;
411 8         1590 my $csv_values = new Text::CSV_XS;
412              
413 8         636 my ($keystring, $valuestring) = split(/\r\n/, $page);
414 8         86 $csv_keys->parse($keystring);
415 8         593 $csv_values->parse($valuestring);
416 8         294 @output{$csv_keys->fields()} = $csv_values->fields();
417              
418 8         501 return %output;
419              
420             }
421              
422             sub parse_SJAPI_TransactionChangeStatusRequest
423             {
424 3     3 0 10 my $page = shift;
425              
426 3         28 my $csv = new Text::CSV_XS;
427              
428 3         376 my %output;
429              
430 3         42 my @records = split(/\r\n/, $page);
431              
432 3 50       22 $csv->parse(shift @records)
433             or die "CSV parse failed on " . $csv->error_input;
434 3         137 @output{@CHANGE_STATUS_RESPONSE} = $csv->fields();
435              
436             # we only handle a single record reponse, as that's all this module will
437             # currently submit...
438 3 50       62 $csv->parse(shift @records)
439             or die "CSV parse failed on " . $csv->error_input;
440 3         70 @output{@CHANGE_STATUS_RESPONSE_RECORD} = $csv->fields();
441              
442 3         96 return %output;
443              
444             }
445              
446             sub parse_SJAPI_TransactionStatusRequest
447             {
448 1     1 0 3 my $page = shift;
449              
450 1         8 my $csv = new Text::CSV_XS;
451              
452 1         108 my %output;
453              
454 1         6 my @records = split(/\r\n/, $page);
455              
456             #$csv->parse(shift @records)
457 1 50       6 $csv->parse(shift @records)
458             or die "CSV parse failed on " . $csv->error_input;
459 1         50 @output{@GET_STATUS_RESPONSE} = $csv->fields();
460              
461             # we only handle a single record reponse, as that's all this module will
462             # currently submit...
463 1 50       23 $csv->parse(shift @records)
464             or die "CSV parse failed on " . $csv->error_input;
465 1         24 @output{@GET_STATUS_RESPONSE_RECORD} = $csv->fields();
466              
467 1         36 return %output;
468              
469             }
470              
471             1;
472              
473             __END__