File Coverage

blib/lib/Business/OnlinePayment/Litle.pm
Criterion Covered Total %
statement 271 775 34.9
branch 83 334 24.8
condition 26 173 15.0
subroutine 34 54 62.9
pod 25 25 100.0
total 439 1361 32.2


line stmt bran cond sub pod time code
1             package Business::OnlinePayment::Litle;
2              
3              
4 4     4   57402 use warnings;
  4         8  
  4         116  
5 4     4   19 use strict;
  4         9  
  4         90  
6              
7 4     4   302 use Business::OnlinePayment;
  4         2499  
  4         97  
8 4     4   964 use Business::OnlinePayment::HTTPS;
  4         60379  
  4         130  
9 4     4   1363 use Business::OnlinePayment::Litle::ErrorCodes '%ERRORS';
  4         15  
  4         359  
10 4     4   28 use vars qw(@ISA $me $DEBUG);
  4         8  
  4         168  
11 4     4   958 use MIME::Base64;
  4         1777  
  4         219  
12 4     4   1623 use HTTP::Tiny;
  4         118092  
  4         147  
13 4     4   1475 use XML::Writer;
  4         21815  
  4         95  
14 4     4   2014 use XML::Simple;
  4         27202  
  4         26  
15 4     4   253 use Tie::IxHash;
  4         7  
  4         84  
16 4     4   1130 use Business::CreditCard qw(cardtype);
  4         6244  
  4         212  
17 4     4   1122 use Data::Dumper;
  4         13414  
  4         178  
18 4     4   1055 use IO::String;
  4         7097  
  4         119  
19 4     4   24 use Carp qw(croak carp);
  4         7  
  4         212  
20 4     4   837 use Log::Scrubber qw(disable $SCRUBBER scrubber :Carp scrubber_add_scrubber);
  4         8973  
  4         17  
21              
22             @ISA = qw(Business::OnlinePayment::HTTPS);
23             $me = 'Business::OnlinePayment::Litle';
24             $DEBUG = 0;
25             our $VERSION = '0.959'; # VERSION
26              
27             # PODNAME: Business::OnlinePayment::Litle
28              
29             # ABSTRACT: Business::OnlinePayment::Litle - Vantiv (was Litle & Co.) Backend for Business::OnlinePayment
30              
31              
32             sub server_request {
33 11     11 1 74 my ( $self, $val, $tf ) = @_;
34 11 100       37 if ($val) {
35 5         36 $self->{server_request} = scrubber $val;
36 5 50       757 $self->server_request_dangerous($val,1) unless $tf;
37             }
38 11         26 return $self->{server_request};
39             }
40              
41              
42             sub server_request_dangerous {
43 5     5 1 22 my ( $self, $val, $tf ) = @_;
44 5 50       15 if ($val) {
45 5         14 $self->{server_request_dangerous} = $val;
46 5 50       17 $self->server_request($val,1) unless $tf;
47             }
48 5         12 return $self->{server_request_dangerous};
49             }
50              
51              
52             sub server_response {
53 11     11 1 34 my ( $self, $val, $tf ) = @_;
54 11 100       36 if ($val) {
55 5         28 $self->{server_response} = scrubber $val;
56 5 50       553 $self->server_response_dangerous($val,1) unless $tf;
57             }
58 11         29 return $self->{server_response};
59             }
60              
61              
62             sub server_response_dangerous {
63 5     5 1 18 my ( $self, $val, $tf ) = @_;
64 5 50       21 if ($val) {
65 5         19 $self->{server_response_dangerous} = $val;
66 5 50       21 $self->server_response($val,1) unless $tf;
67             }
68 5         14 return $self->{server_response_dangerous};
69             }
70              
71              
72              
73             sub _info {
74             return {
75 0     0   0 info_compat => '0.01',
76             gateway_name => 'Litle',
77             gateway_url => 'http://www.vantiv.com',
78             module_version => $VERSION,
79             supported_types => ['CC'],
80             supported_actions => {
81             CC => [
82             'Normal Authorization',
83             'Post Authorization',
84             'Authorization Only',
85             'Credit',
86             'Void',
87             'Auth Reversal',
88             ],
89             },
90             };
91             }
92              
93              
94             sub set_defaults {
95 8     8 1 7413 my $self = shift;
96 8         26 my %opts = @_;
97              
98 8         47 $self->build_subs(
99             qw( order_number md5 avs_code cvv2_response card_token
100             cavv_response api_version xmlns failure_status batch_api_version chargeback_api_version
101             is_prepaid prepaid_balance get_affluence chargeback_server chargeback_port chargeback_path
102             verify_SSL phoenixTxnId is_duplicate card_token card_token_response card_token_message
103             )
104             );
105              
106 8         3081 $self->test_transaction(0);
107              
108 8 50       24 if ( $opts{debug} ) {
109 0         0 $self->debug( $opts{debug} );
110 0         0 delete $opts{debug};
111             }
112              
113             ## load in the defaults
114 8         16 my %_defaults = ();
115 8         24 foreach my $key ( keys %opts ) {
116 8 50       40 $key =~ /^default_(\w*)$/ or next;
117 8         25 $_defaults{$1} = $opts{$key};
118 8         18 delete $opts{$key};
119             }
120              
121 8         20 $self->{_scrubber} = \&_default_scrubber;
122 8 100       22 if( defined $_defaults{'Scrubber'} ) {
123 1         2 my $code = $_defaults{'Scrubber'};
124 1 50       3 if( ref($code) ne 'CODE' ) {
125 0         0 carp('default_Scrubber is not a code ref');
126             }
127             else {
128 1         3 $self->{_scrubber} = $code;
129             }
130             }
131              
132 8 50       130 $self->api_version('11.0') unless $self->api_version;
133 8 50       343 $self->batch_api_version('11.0') unless $self->batch_api_version;
134 8 50       303 $self->chargeback_api_version('2.2') unless $self->chargeback_api_version;
135 8 50       347 $self->xmlns('http://www.litle.com/schema') unless $self->xmlns;
136             }
137              
138              
139             sub test_transaction {
140 15     15 1 13797 my $self = shift;
141 15         30 my $testMode = shift;
142 15 50 0     45 if (! defined $testMode) { $testMode = $self->{'test_transaction'} || 0; }
  0         0  
143              
144 15 100       74 if (lc($testMode) eq 'sandbox') {
    50          
    50          
    100          
145 6         18 $self->{'test_transaction'} = 'sandbox';
146 6         132 $self->verify_SSL(0);
147              
148 6         163 $self->server('www.testvantivcnp.com');
149 6         152 $self->port('443');
150 6         159 $self->path('/sandbox/communicator/online');
151              
152 6         159 $self->chargeback_server('services.vantivpostlive.com'); # no sandbox exists, so fallback to certify
153 6         150 $self->chargeback_port('443');
154 6         143 $self->chargeback_path('/services/communicator/chargebacks/webCommunicator');
155             } elsif (lc($testMode) eq 'localhost') {
156             # this allows the user to create a local web server to do generic testing with
157 0         0 $self->{'test_transaction'} = 'localhost';
158 0         0 $self->verify_SSL(0);
159              
160 0         0 $self->server('localhost');
161 0         0 $self->port('443');
162 0         0 $self->path('/sandbox/communicator/online');
163              
164 0         0 $self->chargeback_server('localhost');
165 0         0 $self->chargeback_port('443');
166 0         0 $self->chargeback_path('/services/communicator/chargebacks/webCommunicator');
167             } elsif (lc($testMode) eq 'prelive') {
168 0         0 $self->{'test_transaction'} = $testMode;
169 0         0 $self->verify_SSL(0);
170              
171 0         0 $self->server('payments.vantivprelive.com');
172 0         0 $self->port('443');
173 0         0 $self->path('/vap/communicator/online');
174              
175 0         0 $self->chargeback_server('services.vantivprelive.com');
176 0         0 $self->chargeback_port('443');
177 0         0 $self->chargeback_path('/services/communicator/chargebacks/webCommunicator');
178             } elsif ($testMode) {
179 1         4 $self->{'test_transaction'} = $testMode;
180 1         19 $self->verify_SSL(0);
181              
182 1         27 $self->server('payments.vantivpostlive.com');
183 1         21 $self->port('443');
184 1         21 $self->path('/vap/communicator/online');
185              
186 1         21 $self->chargeback_server('services.vantivpostlive.com');
187 1         20 $self->chargeback_port('443');
188 1         20 $self->chargeback_path('/services/communicator/chargebacks/webCommunicator');
189             } else {
190 8         32 $self->{'test_transaction'} = 0;
191 8         171 $self->verify_SSL(1);
192              
193 8         191 $self->server('payments.vantivcnp.com');
194 8         212 $self->port('443');
195 8         180 $self->path('/vap/communicator/online');
196              
197 8         169 $self->chargeback_server('services.vantivcnp.com');
198 8         165 $self->chargeback_port('443');
199 8         171 $self->chargeback_path('/services/communicator/chargebacks/webCommunicator');
200             }
201              
202 15         122 return $self->{'test_transaction'};
203             }
204              
205              
206             sub map_fields {
207 6     6 1 15 my ( $self, $content ) = @_;
208              
209 6         17 my $action = lc( $content->{'action'} );
210 6         52 my %actions = (
211             'normal authorization' => 'sale',
212             'authorization only' => 'authorization',
213             'post authorization' => 'capture',
214             'void' => 'void',
215             'credit' => 'credit',
216             'auth reversal' => 'authReversal',
217             'account update' => 'accountUpdate',
218             'tokenize' => 'registerTokenRequest',
219             'force capture' => 'force_capture',
220              
221             # AVS ONLY
222             # Capture Given
223             #
224             );
225 6   33     23 $content->{'TransactionType'} = $actions{$action} || $action;
226              
227 6         41 my $type_translate = {
228             'VISA card' => 'VI',
229             'MasterCard' => 'MC',
230             'Discover card' => 'DI',
231             'American Express card' => 'AX',
232             'Diner\'s Club/Carte Blanche' => 'DI',
233             'JCB' => 'DI',
234             'China Union Pay' => 'DI',
235             };
236              
237             $content->{'card_type'} =
238             $type_translate->{ cardtype( $content->{'card_number'} ) }
239 6 100 33     33 || $content->{'type'} if $content->{'card_number'};
240              
241 6 50 33     149 if ( $content->{recurring_billing}
242             && $content->{recurring_billing} eq 'YES' )
243             {
244 0         0 $content->{'orderSource'} = 'recurring';
245             }
246             else {
247 6         13 $content->{'orderSource'} = 'ecommerce';
248             }
249             $content->{'customerType'} =
250 6 50       27 $content->{'orderSource'} eq 'recurring'
251             ? 'Existing'
252             : 'New'; # new/Existing
253              
254 6         15 $content->{'deliverytype'} = 'SVC';
255              
256             # stuff it back into %content
257 6 50 33     44 if ( $content->{'products'} && ref( $content->{'products'} ) eq 'ARRAY' ) {
258 6         11 my $count = 1;
259 6         13 foreach ( @{ $content->{'products'} } ) {
  6         18  
260 12         29 $_->{'itemSequenceNumber'} = $count++;
261             }
262             }
263              
264 6 50 0     23 if( $content->{'velocity_check'} && (
      33        
265             $content->{'velocity_check'} != 0
266             && $content->{'velocity_check'} !~ m/false/i ) ) {
267 0         0 $content->{'velocity_check'} = 'true';
268             } else {
269 6         14 $content->{'velocity_check'} = 'false';
270             }
271              
272 6 50 0     21 if( $content->{'partial_auth'} && (
      33        
273             $content->{'partial_auth'} != 0
274             && $content->{'partial_auth'} !~ m/false/i ) ) {
275 0         0 $content->{'partial_auth'} = 'true';
276             } else {
277 6         15 $content->{'partial_auth'} = 'false';
278             }
279              
280 6         12 $self->content( %{$content} );
  6         64  
281 6         410 return $content;
282             }
283              
284              
285             sub format_misc_field {
286 288     288 1 502 my ($self, $content, $trunc) = @_;
287              
288 288 100       581 if( defined $content->{ $trunc->[0] } ) {
    50          
289 232         566 utf8::upgrade($content->{ $trunc->[0] });
290 232         443 my $len = length( $content->{ $trunc->[0] } );
291 232 50 100     903 if ( $trunc->[3] && $trunc->[2] && $len != 0 && $len < $trunc->[2] ) {
    50 100        
      66        
      66        
      33        
292             # Zero is a valid length (mostly for cvv2 value)
293 0         0 croak "$trunc->[0] has too few characters";
294             }
295             elsif ( $trunc->[3] && $trunc->[1] && $len > $trunc->[1] ) {
296 0         0 croak "$trunc->[0] has too many characters";
297             }
298 232         609 $content->{ $trunc->[0] } = substr($content->{ $trunc->[0] } , 0, $trunc->[1] );
299             #warn "$trunc->[0] => $len => $content->{ $trunc->[0] }\n" if $DEBUG;
300             }
301             elsif ( $trunc->[4] ) {
302 0         0 croak "$trunc->[0] is required";
303             }
304             }
305              
306              
307             sub format_amount_field {
308 78     78 1 155 my ($self, $data, $field) = @_;
309 78 100       202 if (defined ( $data->{$field} ) ) {
310 54         321 $data->{$field} = sprintf( "%.2f", $data->{$field} );
311 54         207 $data->{$field} =~ s/\.//g;
312             }
313             }
314              
315              
316             sub format_phone_field {
317 6     6 1 17 my ($self, $data, $field) = @_;
318 6 50       17 if (defined ( $data->{$field} ) ) {
319 6         102 my $convertPhone = {
320             'a' => 2, 'b' => 2, 'c' => 2,
321             'd' => 3, 'e' => 3, 'f' => 3,
322             'g' => 4, 'h' => 4, 'i' => 4,
323             'j' => 5, 'k' => 5, 'l' => 5,
324             'm' => 6, 'n' => 6, 'o' => 6,
325             'p' => 7, 'q' => 7, 'r' => 7, 's' => 7,
326             't' => 8, 'u' => 8, 'v' => 8,
327             'w' => 9, 'x' => 9, 'y' => 9, 'z' => 9,
328             };
329 6 50       34 $data->{$field} =~ s/(\D)/$$convertPhone{lc($1)}||''/eg;
  12         85  
330             }
331             }
332              
333              
334             sub map_request {
335 6     6 1 14 my ( $self, $content ) = @_;
336              
337 6         26 $self->map_fields($content);
338              
339 6         13 my $action = $content->{'TransactionType'};
340              
341 6         32 my @required_fields = qw(action type);
342              
343 6         35 $self->required_fields(@required_fields);
344              
345             # for tabbing
346             # set dollar amounts to the required format (eg $5.00 should be 500)
347 6         217 foreach my $field ( 'amount', 'salesTax', 'discountAmount', 'shippingAmount', 'dutyAmount' ) {
348 30         67 $self->format_amount_field($content, $field);
349             }
350              
351             # make sure the date is in MMYY format
352 6         62 $content->{'expiration'} =~ s/^(\d{1,2})\D*\d*?(\d{2})$/$1$2/;
353              
354 6 50       25 if ( ! defined $content->{'description'} ) { $content->{'description'} = ''; } # schema req
  0         0  
355 6         23 $content->{'description'} =~ s/[^\w\s\*\,\-\'\#\&\.]//g;
356              
357             # Litle pre 0.934 used token, however BOP likes card_token
358 6 50 66     32 $content->{'card_token'} = $content->{'token'} if ! defined $content->{'card_token'} && defined $content->{'card_token'};
359              
360             # only numbers are allowed in company_phone
361 6         32 $self->format_phone_field($content, 'company_phone');
362              
363 6   33     39 $content->{'invoice_number_length_15'} ||= $content->{'invoice_number'}; # orderId = 25, invoiceReferenceNumber = 15
364              
365             # put in a list of constraints
366 6         139 my @validate = (
367             # field, maxLen, minLen, errorOnLength, isRequired
368             [ 'name', 100, 0, 0, 0 ],
369             [ 'email', 100, 0, 0, 0 ],
370             [ 'address', 35, 0, 0, 0 ],
371             [ 'city', 35, 0, 0, 0 ],
372             [ 'state', 30, 0, 0, 0 ], # 30 is allowed, but it should be the 2 char code
373             [ 'zip', 20, 0, 0, 0 ],
374             [ 'country', 3, 0, 0, 0 ], # should use iso 3166-1 2 char code
375             [ 'phone', 20, 0, 0, 0 ],
376              
377             [ 'ship_name', 100, 0, 0, 0 ],
378             [ 'ship_email', 100, 0, 0, 0 ],
379             [ 'ship_address',35, 0, 0, 0 ],
380             [ 'ship_city', 35, 0, 0, 0 ],
381             [ 'ship_state', 30, 0, 0, 0 ], # 30 is allowed, but it should be the 2 char code
382             [ 'ship_zip', 20, 0, 0, 0 ],
383             [ 'ship_country', 3, 0, 0, 0 ], # should use iso 3166-1 2 char code
384             [ 'ship_phone', 20, 0, 0, 0 ],
385              
386             #[ 'customerType',13, 0, 0, 0 ],
387              
388             ['company_phone',13, 0, 0, 0 ],
389             [ 'description', 25, 0, 0, 0 ],
390              
391             [ 'po_number', 17, 0, 0, 0 ],
392             [ 'salestax', 8, 0, 1, 0 ],
393             [ 'discount', 8, 0, 1, 0 ],
394             [ 'shipping', 8, 0, 1, 0 ],
395             [ 'duty', 8, 0, 1, 0 ],
396             ['invoice_number',25, 0, 0, 0 ],
397             ['invoice_number_length_15',15,0, 0, 0 ],
398             [ 'orderdate', 10, 0, 0, 0 ], # YYYY-MM-DD
399              
400             [ 'recycle_by', 8, 0, 0, 0 ],
401             [ 'recycle_id', 25, 0, 0, 0 ],
402              
403             [ 'affiliate', 25, 0, 0, 0 ],
404              
405             [ 'card_type', 2, 2, 1, 0 ],
406             [ 'card_number', 25, 13, 1, 0 ],
407             [ 'expiration', 4, 4, 1, 0 ], # MMYY
408             [ 'cvv2', 4, 3, 1, 0 ],
409             # 'card_token' does not have a documented limit
410              
411             [ 'customer_id', 25, 0, 0, 0 ],
412             );
413 6         16 foreach my $trunc ( @validate ) {
414 204         375 $self->format_misc_field($content,$trunc);
415             #warn "$trunc->[0] => ".($content->{ $trunc->[0] }||'')."\n" if $DEBUG;
416             }
417              
418 6         37 tie my %customer_info, 'Tie::IxHash', $self->_revmap_fields(
419             content => $content,
420             ssn => 'ssn',
421             dob => 'dob',
422             customerRegistrationDate => 'registration_date',
423             customerType => 'customer_type',
424             incomeAmount => 'income_amount',
425             incomeCurrency => 'income_currency',
426             employerName => 'employer_name',
427             customerWorkTelephone => 'work_phone',
428             residenceStatus => 'residence_status',
429             yearsAtResidence => 'residence_years',
430             yearsAtEmployer => 'employer_years',
431             );
432              
433 6         95 tie my %billToAddress, 'Tie::IxHash', $self->_revmap_fields(
434             content => $content,
435             name => 'name',
436             addressLine1 => 'address',
437             addressLine2 => 'address2',
438             addressLine3 => 'address3',
439             city => 'city',
440             state => 'state',
441             zip => 'zip',
442             country => 'country',
443             email => 'email',
444             phone => 'phone',
445             );
446              
447 6         596 tie my %shipToAddress, 'Tie::IxHash', $self->_revmap_fields(
448             content => $content,
449             name => 'ship_name',
450             addressLine1 => 'ship_address',
451             addressLine2 => 'ship_address2',
452             addressLine3 => 'ship_address3',
453             city => 'ship_city',
454             state => 'ship_state',
455             zip => 'ship_zip',
456             country => 'ship_country'
457             , #TODO: will require validation to the spec, this field wont' work as is
458             email => 'ship_email',
459             phone => 'ship_phone',
460             );
461              
462 6         496 tie my %customerinfo, 'Tie::IxHash',
463             $self->_revmap_fields(
464             content => $content,
465             customerType => 'customerType',
466             );
467              
468 6         184 tie my %custombilling, 'Tie::IxHash',
469             $self->_revmap_fields(
470             content => $content,
471             phone => 'company_phone',
472             descriptor => 'description',
473             #url => 'url',
474             );
475              
476             ## loop through product list and generate lineItemData for each
477             #
478 6         250 my @products = ();
479 6 50 33     26 if( defined $content->{'products'} && scalar( @{ $content->{'products'} } ) < 100 ){
  6         32  
480 6         13 foreach my $prodOrig ( @{ $content->{'products'} } ) {
  6         21  
481             # use a local copy of prod so that we do not have issues if they try to submit more then once.
482 12         96 my %prod = %$prodOrig;
483 12         39 foreach my $field ( 'tax','amount','totalwithtax','discount' ) {
484             # Note: DO NOT format 'cost', it uses the decimal format
485 48         98 $self->format_amount_field(\%prod, $field);
486             }
487              
488 12         73 my @validate = (
489             # field, maxLen, minLen, errorOnLength, isRequired
490             [ 'description', 26, 0, 0, 0 ],
491             [ 'tax', 8, 0, 1, 0 ],
492             [ 'amount', 8, 0, 1, 0 ],
493             [ 'totalwithtax', 8, 0, 1, 0 ],
494             [ 'discount', 8, 0, 1, 0 ],
495             [ 'code', 12, 0, 0, 0 ],
496             [ 'cost', 12, 0, 1, 0 ],
497             );
498 12         22 foreach my $trunc ( @validate ) { $self->format_misc_field(\%prod,$trunc); }
  84         159  
499              
500 12         42 tie my %lineitem, 'Tie::IxHash',
501             $self->_revmap_fields(
502             content => \%prod,
503             itemSequenceNumber => 'itemSequenceNumber',
504             itemDescription => 'description',
505             productCode => 'code',
506             quantity => 'quantity',
507             unitOfMeasure => 'units',
508             taxAmount => 'tax',
509             lineItemTotal => 'amount',
510             lineItemTotalWithTax => 'totalwithtax',
511             itemDiscountAmount => 'discount',
512             commodityCode => 'code',
513             unitCost => 'cost', # This "amount" field uses decimals
514             );
515 12         1645 push @products, \%lineitem;
516             }
517             }
518              
519 6         23 tie my %filtering, 'Tie::IxHash', $self->_revmap_fields(
520             content => $content,
521             prepaid => 'filter_prepaid',
522             international => 'filter_international',
523             chargeback => 'filter_chargeback',
524             );
525              
526 6         99 tie my %healthcaresub, 'Tie::IxHash', $self->_revmap_fields(
527             content => $content,
528             totalHealthcareAmount => 'amount_healthcare',
529             RxAmount => 'amount_medications',
530             visionAmount => 'amount_vision',
531             clinicOtherAmount => 'amount_clinic',
532             dentalAmount => 'amount_dental',
533             );
534              
535 6         88 tie my %healthcare, 'Tie::IxHash', $self->_revmap_fields(
536             content => $content,
537             healthcareAmounts => \%healthcaresub,
538             IIASFlag => 'healthcare_flag',
539             );
540              
541 6         85 tie my %amexaggregator, 'Tie::IxHash', $self->_revmap_fields(
542             content => $content,
543             sellerId => 'amex_seller_id',
544             sellerMerchantCategoryCode => 'amex_merch_code',
545             );
546              
547 6         85 tie my %detailtax, 'Tie::IxHash', $self->_revmap_fields(
548             content => $content,
549             taxIncludedInTotal => 'tax_in_total',
550             taxAmount => 'tax_amount',
551             taxRate => 'tax_rate',
552             taxTypeIdentifier => 'tax_type',
553             cardAcceptorTaxId => 'tax_id',
554             );
555             #
556             #
557 6         112 tie my %enhanceddata, 'Tie::IxHash', $self->_revmap_fields(
558             content => $content,
559             customerReference => 'po_number',
560             salesTax => 'salestax',
561             deliveryType => 'deliverytype',
562             taxExempt => 'tax_exempt',
563             discountAmount => 'discount',
564             shippingAmount => 'shipping',
565             dutyAmount => 'duty',
566             shipFromPostalCode => 'company_zip',
567             destinationPostalCode => 'ship_zip',
568             destinationCountryCode => 'ship_country',
569             invoiceReferenceNumber => 'invoice_number_length_15',
570             orderDate => 'orderdate',
571             detailTax => \%detailtax,
572             lineItemData => \@products,
573             );
574              
575 6         459 tie my %card, 'Tie::IxHash', $self->_revmap_fields(
576             content => $content,
577             type => 'card_type',
578             number => 'card_number',
579             expDate => 'expiration',
580             cardValidationNum => 'cvv2',
581             pin => 'pin',
582             );
583              
584 6         346 tie my %token, 'Tie::IxHash', $self->_revmap_fields(
585             content => $content,
586             litleToken => 'card_token',
587             expDate => 'expiration',
588             cardValidationNum => 'cvv2',
589             );
590              
591 6         269 tie my %sepadirect, 'Tie::IxHash', $self->_revmap_fields(
592             content => $content,
593             mandateProvider => 'sepa_mandate_provider',
594             sequenceType => 'sepa_sequence_type',
595             mandateReference => 'sepa_mandate_reference',
596             mandateUrl => 'sepa_mandate_url',
597             mandateSignatureDate => 'sepa_mandate_signature_date',
598             iban => 'sepa_iban',
599             preferredLanguage => 'sepa_language',
600             );
601            
602 6         84 tie my %ideal, 'Tie::IxHash', $self->_revmap_fields(
603             content => $content,
604             preferredLanguage => 'ideal_language',
605             );
606              
607 6         83 tie my %processing, 'Tie::IxHash', $self->_revmap_fields(
608             content => $content,
609             bypassVelocityCheck => 'velocity_check',
610             );
611              
612 6         186 tie my %pos, 'Tie::IxHash', $self->_revmap_fields(
613             content => $content,
614             capability => 'pos_capability',
615             entryMode => 'pos_entry_mode',
616             cardholderId => 'pos_cardholder_id',
617             terminalId => 'pos_terminal_id',
618             catLevel => 'pos_cat_level',
619             #For CAT (Cardholder Activated Terminal) transactions, the capability element must be set to magstripe, the cardholderId element must be set to nopin, and the catLevel element must be set to self service.
620             );
621              
622 6         94 tie my %cardholderauth, 'Tie::IxHash',
623             $self->_revmap_fields(
624             content => $content,
625             authenticationValue => '3ds',
626             authenticationTransactionId => 'visaverified',
627             customerIpAddress => 'ip',
628             authenticatedByMerchant => 'authenticated',
629             );
630              
631 6         183 tie my %merchantdata, 'Tie::IxHash',
632             $self->_revmap_fields(
633             content => $content,
634             affiliate => 'affiliate',
635             merchantGroupingId => 'merchant_grouping_id',
636             );
637              
638 6         188 tie my %recyclingrequest, 'Tie::IxHash',
639             $self->_revmap_fields(
640             content => $content,
641             recycleBy => 'recycle_by',
642             recycleId => 'recycle_id',
643             );
644              
645 6         245 tie my %recurringRequest, 'Tie::IxHash',
646             $self->_revmap_fields(
647             content => $content,
648             planCode => 'recurring_plan_code',
649             numberOfPayments => 'recurring_number_of_payments',
650             startDate => 'recurring_start_date',
651             amount => 'recurring_amount',
652             );
653            
654 6         89 tie my %advancedfraud, 'Tie::IxHash',
655             $self->_revmap_fields(
656             content => $content,
657             threatMetrixSessionId => 'threatMetrixSessionId',
658             customAttribute1 => 'advanced_fraud_customAttribute1',
659             customAttribute2 => 'advanced_fraud_customAttribute2',
660             customAttribute3 => 'advanced_fraud_customAttribute3',
661             customAttribute4 => 'advanced_fraud_customAttribute4',
662             customAttribute5 => 'advanced_fraud_customAttribute5',
663             );
664              
665 6         83 tie my %wallet, 'Tie::IxHash',
666             $self->_revmap_fields(
667             content => $content,
668             walletSourceType => 'wallet_source_type',
669             walletSourceTypeId => 'wallet_source_type_id',
670             );
671              
672 6         87 my %req;
673              
674 6 50       27 if ( $action eq 'registerTokenRequest' ) {
    100          
    50          
    0          
    0          
    0          
    0          
    0          
    0          
675 0 0 0     0 croak 'missing card_number' if length($content->{'card_number'} || '') == 0;
676 0         0 tie %req, 'Tie::IxHash', $self->_revmap_fields(
677             content => $content,
678             orderId => 'invoice_number',
679             accountNumber => 'card_number',
680             );
681             }
682             elsif ( $action eq 'sale' ) {
683 5 100 100     222 croak 'missing card_token or card_number' if length($content->{'card_number'} || $content->{'card_token'} || '') == 0;
684             tie %req, 'Tie::IxHash', $self->_revmap_fields(
685             content => $content,
686             orderId => 'invoice_number',
687             amount => 'amount',
688             secondaryAmount => 'secondary_amount',
689             orderSource => 'orderSource',
690             customerInfo => \%customer_info, # PP only
691             billToAddress => \%billToAddress,
692             shipToAddress => \%shipToAddress,
693             card => $content->{'card_number'} ? \%card : {},
694 4 100       48 token => $content->{'card_token'} ? \%token : {},
    100          
695             #[||||||
696             #|] (Choice)
697             sepaDirectDebit => \%sepadirect,
698             ideal => \%ideal,
699             cardholderAuthentication => \%cardholderauth,
700             customBilling => \%custombilling,
701             taxType => 'tax_type', # payment|fee
702             enhancedData => \%enhanceddata,
703             processingInstructions => \%processing,
704             amexAggregatorData => \%amexaggregator,
705             allowPartialAuth => 'partial_auth',
706             healthcareIIAS => \%healthcare,
707             filtering => \%filtering,
708             merchantData => \%merchantdata,
709             recyclingRequest => \%recyclingrequest,
710             fraudFilterOverride => 'filter_fraud_override',
711             recurringRequest => \%recurringRequest,
712             debtRepayment => 'debt_repayment',
713             advancedFraudChecks => \%advancedfraud,
714             wallet => \%wallet,
715             processingType => 'processing_type',
716             originalNetworkTransactionId => 'original_network_transaction_id',
717             originalTransactionAmount => 'original_transaction_amount',
718             );
719             }
720             elsif ( $action eq 'authorization' ) {
721 1 50 0     5 croak 'missing card_token or card_number' if length($content->{'card_number'} || $content->{'card_token'} || '') == 0;
722             tie %req, 'Tie::IxHash', $self->_revmap_fields(
723             content => $content,
724             orderId => 'invoice_number',
725             amount => 'amount',
726             secondaryAmount => 'secondary_amount',
727             orderSource => 'orderSource',
728             customerInfo => \%customer_info, # PP only
729             billToAddress => \%billToAddress,
730             shipToAddress => \%shipToAddress,
731             card => $content->{'card_number'} ? \%card : {},
732 1 50       11 token => $content->{'card_token'} ? \%token : {},
    50          
733              
734             cardholderAuthentication => \%cardholderauth,
735             processingInstructions => \%processing,
736             pos => \%pos,
737             customBilling => \%custombilling,
738             taxType => 'tax_type', # payment|fee
739             enhancedData => \%enhanceddata,
740             amexAggregatorData => \%amexaggregator,
741             allowPartialAuth => 'partial_auth',
742             healthcareIIAS => \%healthcare,
743             filtering => \%filtering,
744             merchantData => \%merchantdata,
745             recyclingRequest => \%recyclingrequest,
746             fraudFilterOverride => 'filter_fraud_override',
747             recurringRequest => \%recurringRequest,
748             debtRepayment => 'debt_repayment',
749             advancedFraudChecks => \%advancedfraud,
750             wallet => \%wallet,
751             processingType => 'processing_type',
752             originalNetworkTransactionId => 'original_network_transaction_id',
753             originalTransactionAmount => 'original_transaction_amount',
754              
755             );
756             }
757             elsif ( $action eq 'capture' ) {
758 0         0 push @required_fields, qw( order_number amount );
759 0         0 tie %req, 'Tie::IxHash',
760             $self->_revmap_fields(
761             # partial is an element of the start tag, so located in the header
762             content => $content,
763             litleTxnId => 'order_number',
764             amount => 'amount',
765             surchargeAmount => 'surcharge_amount',
766             enhancedData => \%enhanceddata,
767             processingInstructions => \%processing,
768             payPalOrderComplete => 'paypal_order_complete',
769             pin => 'pin',
770             );
771             }
772             elsif ( $action eq 'force_capture' ) {
773             ## ARE YOU SURE YOU WANT TO DO THIS?
774             # Seriously, force captures are like running up the pirate flag, check with your Vantiv rep
775 0         0 push @required_fields, qw( order_number amount );
776             tie %req, 'Tie::IxHash',
777             $self->_revmap_fields(
778             # partial is an element of the start tag, so located in the header
779             content => $content,
780             litleTxnId => 'order_number',
781             amount => 'amount',
782             secondaryAmount => 'secondary_amount',
783             orderSource => 'orderSource',
784             billToAddress => \%billToAddress,
785             card => $content->{'card_number'} ? \%card : {},
786 0 0       0 token => $content->{'card_token'} ? \%token : {},
    0          
787             customBilling => \%custombilling,
788             taxType => 'tax_type', # payment|fee
789             enhancedData => \%enhanceddata,
790             processingInstructions => \%processing,
791             amexAggregatorData => \%amexaggregator,
792             merchantData => \%merchantdata,
793             debtRepayment => 'debt_repayment',
794             processingType => 'processing_type',
795             );
796             }
797             elsif ( $action eq 'credit' ) {
798              
799             # IF there is a litleTxnId, it's a normal linked credit
800 0 0       0 if( $content->{'order_number'} ){
801 0         0 push @required_fields, qw( order_number amount );
802 0         0 tie %req, 'Tie::IxHash', $self->_revmap_fields(
803             content => $content,
804             litleTxnId => 'order_number',
805             amount => 'amount',
806             secondaryAmount => 'secondary_amount',
807             customBilling => \%custombilling,
808             enhancedData => \%enhanceddata,
809             processingInstructions => \%processing,
810             actionReason => 'action_reason', # ENUM(SUSPECT_FRAUD) only option atm
811             );
812             }
813             # ELSE it's an unlinked, which requires different data
814             else {
815 0 0 0     0 croak 'missing card_token or card_number' if length($content->{'card_number'} || $content->{'card_token'} || '') == 0;
816 0         0 push @required_fields, qw( invoice_number amount );
817             tie %req, 'Tie::IxHash', $self->_revmap_fields(
818             content => $content,
819             orderId => 'invoice_number',
820             amount => 'amount',
821             orderSource => 'orderSource',
822             billToAddress => \%billToAddress,
823             card => $content->{'card_number'} ? \%card : {},
824 0 0       0 token => $content->{'card_token'} ? \%token : {},
    0          
825             customBilling => \%custombilling,
826             taxType => 'tax_type',
827             enhancedData => \%enhanceddata,
828             processingInstructions => \%processing,
829             pos => \%pos,
830             amexAggregatorData => \%amexaggregator,
831             merchantData => \%merchantdata,
832             actionReason => 'action_reason', # ENUM(SUSPECT_FRAUD) only option atm
833             );
834             }
835             }
836             elsif ( $action eq 'void' ) {
837 0         0 push @required_fields, qw( order_number );
838 0         0 tie %req, 'Tie::IxHash',
839             $self->_revmap_fields(
840             content => $content,
841             litleTxnId => 'order_number',
842             processingInstructions => \%processing,
843             );
844             }
845             elsif ( $action eq 'authReversal' ) {
846 0         0 push @required_fields, qw( order_number amount );
847 0         0 tie %req, 'Tie::IxHash',
848             $self->_revmap_fields(
849             content => $content,
850             litleTxnId => 'order_number',
851             amount => 'amount',
852             actionReason => 'action_reason', # ENUM(SUSPECT_FRAUD) only option atm
853             );
854             }
855             elsif ( $action eq 'accountUpdate' ) {
856 0         0 push @required_fields, qw( card_number expiration );
857 0         0 tie %req, 'Tie::IxHash',
858             $self->_revmap_fields(
859             content => $content,
860             orderId => 'customer_id',
861             card => \%card,
862             );
863             }
864              
865 5         814 $self->required_fields(@required_fields);
866 5         300 return \%req;
867             }
868              
869             sub submit {
870 0     0 1 0 my ($self) = @_;
871              
872 0         0 local $SCRUBBER=1;
873 0         0 $self->_litle_init;
874              
875 0         0 my %content = $self->content();
876              
877 0 0       0 warn 'Pre processing: '.Dumper(\%content) if $DEBUG;
878 0         0 my $req = $self->map_request( \%content );
879 0 0       0 warn 'Post processing: '.Dumper(\%content) if $DEBUG;
880 0         0 my $post_data;
881              
882 0         0 my $writer = XML::Writer->new(
883             OUTPUT => \$post_data,
884             DATA_MODE => 1,
885             DATA_INDENT => 2,
886             ENCODING => 'utf-8',
887             );
888              
889             ## set the authentication data
890 0         0 tie my %authentication, 'Tie::IxHash',
891             $self->_revmap_fields(
892             content => \%content,
893             user => 'login',
894             password => 'password',
895             );
896              
897 0 0       0 warn Dumper($req) if $DEBUG;
898             ## Start the XML Document, parent tag
899 0         0 $writer->xmlDecl();
900             $writer->startTag(
901             "litleOnlineRequest",
902             version => $self->api_version,
903             xmlns => $self->xmlns,
904 0         0 merchantId => $content{'merchantid'},
905             );
906              
907 0         0 $self->_xmlwrite( $writer, 'authentication', \%authentication );
908              
909             ## partial capture modifier, odd location, because it modifies the start tag :(
910 0         0 my %extra;
911 0 0       0 if ($content{'TransactionType'} eq 'capture'){
912 0 0       0 $extra{'partial'} = $content{'partial'} ? 'true' : 'false';
913             }
914              
915             $writer->startTag(
916             $content{'TransactionType'},
917             id => $content{'invoice_number'},
918             reportGroup => $content{'report_group'} || 'BOP',
919 0   0     0 customerId => $content{'customer_id'} || 1,
      0        
920             %extra,
921             );
922 0         0 foreach ( keys( %{$req} ) ) {
  0         0  
923 0         0 $self->_xmlwrite( $writer, $_, $req->{$_} );
924             }
925              
926 0         0 $writer->endTag( $content{'TransactionType'} );
927 0         0 $writer->endTag("litleOnlineRequest");
928 0         0 $writer->end();
929             ## END XML Generation
930              
931 0         0 $self->server_request( $post_data );
932 0 0       0 warn $self->server_request if $DEBUG;
933              
934 0 0       0 if ( $] ge '5.008' ) {
935             # http_post expects data in this format
936 0 0       0 utf8::encode($post_data) if utf8::is_utf8($post_data);
937             }
938              
939 0         0 my ( $page, $status_code, %headers ) = $self->https_post( { 'Content-Type' => 'text/xml; charset=utf-8' } , $post_data);
940              
941 0         0 $self->server_response( $page );
942 0 0       0 warn Dumper $self->server_response, $status_code, \%headers if $DEBUG;
943              
944 0         0 my $response = $self->_parse_xml_response( $page, $status_code );
945              
946 0         0 $content{'TransactionType'} =~ s/Request$//; # no clue why some of the types have a Request and some do not
947              
948 0 0 0     0 if ( exists( $response->{'response'} ) && $response->{'response'} == 1 ) {
949             ## parse error type error
950 0         0 warn Dumper 'https://'.$self->server.':'.$self->port.$self->path,$response, $self->server_request;
951 0         0 $self->error_message( $response->{'message'} );
952 0         0 return;
953             } else {
954             $self->error_message(
955             $response->{ $content{'TransactionType'} . 'Response' }
956 0         0 ->{'message'} );
957             }
958 0         0 $self->{_response} = $response;
959              
960 0 0       0 warn Dumper($response) if $DEBUG;
961              
962             ## Set up the data:
963 0         0 my $resp = $response->{ $content{'TransactionType'} . 'Response' };
964 0         0 $self->{_response} = $resp;
965 0   0     0 $self->card_token( $resp->{'litleToken'} || $resp->{'tokenResponse'}->{'litleToken'} || $content{'card_token'} || '' );
966 0   0     0 $self->order_number( $resp->{'litleTxnId'} || '' );
967 0   0     0 $self->result_code( $resp->{'response'} || '' );
968 0 0       0 $resp->{'authCode'} =~ s/\D//g if $resp->{'authCode'};
969 0   0     0 $self->authorization( $resp->{'authCode'} || '' );
970 0   0     0 $self->cvv2_response( $resp->{'fraudResult'}->{'cardValidationResult'}
971             || '' );
972 0   0     0 $self->avs_code( $resp->{'fraudResult'}->{'avsResult'} || '' );
973 0 0 0     0 if( $resp->{enhancedAuthResponse}
      0        
974             && $resp->{enhancedAuthResponse}->{fundingSource}
975             && $resp->{enhancedAuthResponse}->{fundingSource}->{type} eq 'PREPAID' ) {
976              
977 0         0 $self->is_prepaid(1);
978 0         0 $self->prepaid_balance( $resp->{enhancedAuthResponse}->{fundingSource}->{availableBalance} );
979             } else {
980 0         0 $self->is_prepaid(0);
981             }
982              
983             #$self->is_dupe( $resp->{'duplicate'} ? 1 : 0 );
984 0 0 0     0 if( defined $resp->{'duplicate'} && $resp->{'duplicate'} eq 'true' ) {
985 0         0 $self->is_duplicate(1);
986             }
987             else {
988 0         0 $self->is_duplicate(0);
989             }
990              
991 0 0       0 if( defined $resp->{tokenResponse} ) {
992 0         0 $self->card_token($resp->{tokenResponse}->{litleToken});
993 0         0 $self->card_token_response($resp->{tokenResponse}->{tokenResponseCode});
994 0         0 $self->card_token_message($resp->{tokenResponse}->{tokenMessage});
995             }
996              
997 0 0 0     0 if( $resp->{enhancedAuthResponse}
998             && $resp->{enhancedAuthResponse}->{affluence}
999             ){
1000 0         0 $self->get_affluence( $resp->{enhancedAuthResponse}->{affluence} );
1001             }
1002 0 0       0 $self->is_success( $self->result_code() eq '000' ? 1 : 0 );
1003 0 0 0     0 if(
      0        
1004             $self->result_code() eq '010' # Partial approval, if they chose that option
1005             || ($self->result_code() eq '802' && $self->card_token) # Card is already a token
1006             ) {
1007 0         0 $self->is_success(1);
1008             }
1009              
1010             ##Failure Status for 3.0 users
1011 0 0       0 if ( !$self->is_success ) {
1012             my $f_status =
1013             $ERRORS{ $self->result_code }->{'failure'}
1014 0 0       0 ? $ERRORS{ $self->result_code }->{'failure'}
1015             : 'decline';
1016 0         0 $self->failure_status($f_status);
1017             }
1018              
1019 0 0       0 unless ( $self->is_success() ) {
1020 0 0       0 unless ( $self->error_message() ) {
1021             $self->error_message( "(HTTPS response: $status_code) "
1022             . "(HTTPS headers: "
1023 0         0 . join( ", ", map { "$_ => " . $headers{$_} } keys %headers )
  0         0  
1024             . ") "
1025             . "(Raw HTTPS content: ".$self->server_response().")" );
1026             }
1027             }
1028              
1029             }
1030              
1031              
1032             sub chargeback_retrieve_support_doc {
1033 0     0 1 0 my ( $self ) = @_;
1034 0         0 $self->_litle_support_doc('RETRIEVE');
1035 0 0       0 if ($self->is_success) { $self->{'fileContent'} = $self->{'server_response_dangerous'}; } else { $self->{'fileContent'} = undef; }
  0         0  
  0         0  
1036             }
1037              
1038              
1039             sub chargeback_delete_support_doc {
1040 0     0 1 0 my ( $self ) = @_;
1041 0         0 $self->_litle_support_doc('DELETE' );
1042             }
1043              
1044              
1045             sub chargeback_upload_support_doc {
1046 0     0 1 0 my ( $self ) = @_;
1047 0         0 $self->_litle_support_doc('UPLOAD' );
1048             }
1049              
1050              
1051             sub chargeback_replace_support_doc {
1052 0     0 1 0 my ( $self ) = @_;
1053 0         0 $self->_litle_support_doc('REPLACE' );
1054             }
1055              
1056             sub _litle_support_doc {
1057 0     0   0 my ( $self, $action ) = @_;
1058              
1059 0         0 local $SCRUBBER=1;
1060 0         0 $self->_litle_init;
1061              
1062 0         0 my %content = $self->content();
1063              
1064 0         0 my $requiredargs = ['case_id','filename','merchantid'];
1065 0 0       0 if ($action =~ /(?:UPLOAD|REPLACE)/) { push @$requiredargs, 'filecontent', 'mimetype'; }
  0         0  
1066 0         0 foreach my $key (@$requiredargs) {
1067 0 0       0 croak "Missing arg $key" unless $content{$key};
1068             }
1069              
1070 0         0 my $actionRESTful = {
1071             'DELETE' => 'DELETE',
1072             'RETRIEVE' => 'GET',
1073             'UPLOAD' => 'POST',
1074             'REPLACE' => 'PUT',
1075             };
1076 0 0       0 die "UNDEFINED ACTION: $action" unless defined $actionRESTful->{$action};
1077              
1078             {
1079 4     4   15027 use bytes;
  4         9  
  4         26  
  0         0  
1080 0 0       0 if ( defined $content{'filecontent'} ) {
1081 0 0       0 if ( length($content{'filecontent'}) > 2097152 ) { # file limit of 2M
1082 0         0 my $msg = 'Filesize Exceeds Limit Of 2MB';
1083 0         0 $self->result_code( 012 ); ## no critic
1084 0         0 $self->error_message( $msg );
1085 0         0 croak $msg;
1086             }
1087 0         0 my $allowedTypes = {
1088             'application/pdf' => 1,
1089             'image/gif' => 1,
1090             'image/jpeg' => 1,
1091             'image/png' => 1,
1092             'image/tiff' => 1,
1093             };
1094 0 0 0     0 if ( ! defined $allowedTypes->{$content{'mimetype'}||''} ) {
1095 0         0 croak "File must be one of PDF/GIF/JPG/PNG/TIFF".$content{'mimetype'};
1096             }
1097             }
1098             }
1099              
1100 0         0 my $caseidURI = $content{'case_id'};
1101 0         0 my $filenameURI = $content{'filename'};
1102 0         0 my $merchantidURI = $content{'merchantid'};
1103 0         0 foreach ( $caseidURI, $filenameURI, $merchantidURI ) {
1104 0         0 s/([^a-z0-9\.\-])/sprintf('%%%X',ord($1))/ige;
  0         0  
1105             }
1106              
1107 0         0 my $url = 'https://'.$self->chargeback_server.':'.$self->chargeback_port.'//services/chargebacks/documents/'.$merchantidURI.'/'.$caseidURI.'/'.$filenameURI;
1108             my $response = HTTP::Tiny->new( verify_SSL=>$self->verify_SSL )->request($actionRESTful->{$action}, $url, {
1109             headers => {
1110             'Authorization' => 'Basic ' . MIME::Base64::encode("$content{'login'}:$content{'password'}",''),
1111             'Content-Type' => $content{'mimetype'} || 'text/plain',
1112             },
1113 0   0     0 content => $content{'filecontent'},
1114             } );
1115              
1116 0         0 $self->server_request( $content{'mimetype'} );
1117 0         0 $self->server_response( $response->{'content'} );
1118              
1119 0 0 0     0 if ( $action eq 'RETRIEVE' && $response->{'status'} =~ /^200/ && substr($response->{'content'},0,500) !~ /
      0        
1120             # the RETRIEVE action returns the actual page as the file, rather then returning XML
1121 0         0 $self->is_success(1);
1122             } else {
1123 0         0 my $xml_response = $self->_parse_xml_response( $response->{'content'}, $response->{'status'} );
1124              
1125 0 0 0     0 if (defined $xml_response && defined $xml_response->{'ChargebackCase'}{'Document'}{'ResponseCode'}) {
1126 0 0       0 $self->is_success( $xml_response->{'ChargebackCase'}{'Document'}{'ResponseCode'} eq '000' ? 1 : 0 );
1127 0         0 $self->result_code( $xml_response->{'ChargebackCase'}{'Document'}{'ResponseCode'} );
1128 0         0 $self->error_message( $xml_response->{'ChargebackCase'}{'Document'}{'ResponseMessage'} );
1129             } else {
1130 0         0 croak "UNRECOGNIZED RESULT: ".$self->server_response;
1131             }
1132             }
1133             }
1134              
1135              
1136             sub chargeback_list_support_docs {
1137 0     0 1 0 my ( $self ) = @_;
1138              
1139 0         0 local $SCRUBBER=1;
1140 0         0 $self->_litle_init;
1141              
1142 0         0 my %content = $self->content();
1143              
1144 0 0       0 croak "Missing arg case_id" unless $content{'case_id'};
1145 0 0       0 croak "Missing arg merchantid" unless $content{'merchantid'};
1146 0         0 my $caseidURI = $content{'case_id'};
1147 0         0 my $merchantidURI = $content{'merchantid'};
1148 0         0 foreach ( $caseidURI, $merchantidURI ) {
1149 0         0 s/([^a-z0-9\.\-])/sprintf('%%%X',ord($1))/ige;
  0         0  
1150             }
1151              
1152 0         0 my $url = 'https://'.$self->chargeback_server.':'.$self->chargeback_port.'//services/chargebacks/documents/'.$merchantidURI.'/'.$caseidURI.'/';
1153 0         0 my $response = HTTP::Tiny->new( verify_SSL=>$self->verify_SSL )->request('GET', $url, {
1154             headers => { Authorization => 'Basic ' . MIME::Base64::encode("$content{'login'}:$content{'password'}",'') },
1155             } );
1156              
1157 0         0 $self->server_request( $url );
1158 0         0 $self->server_response( $response->{'content'} );
1159              
1160 0         0 my $xml_response = $self->_parse_xml_response( $response->{'content'}, $response->{'status'} );
1161              
1162 0 0 0     0 if (defined $xml_response && $xml_response->{'ChargebackCase'}{'ResponseCode'}) {
    0 0        
1163 0         0 $self->result_code( $xml_response->{'ChargebackCase'}{'ResponseCode'} );
1164 0         0 $self->error_message( $xml_response->{'ChargebackCase'}{'ResponseMessage'} );
1165             } elsif (defined $xml_response && $xml_response->{'ChargebackCase'}{'DocumentEntry'}) {
1166 0         0 $self->is_success(1);
1167 0         0 $self->result_code( '000' );
1168              
1169 0         0 my $ref = $xml_response->{'ChargebackCase'}{'DocumentEntry'};
1170 0 0 0     0 if (defined $ref->{'id'} && ref $ref->{'id'} eq '') {
1171             # XMLin does not parse the result properly for a single document. This fixes the single document format to match the multi-doc format
1172 0         0 $ref = { $ref->{'id'} => $ref };
1173             }
1174 0         0 return $ref;
1175             } else {
1176 0         0 croak "UNRECOGNIZED RESULT: ".$self->server_response;
1177             }
1178 0         0 return {};
1179             }
1180              
1181             sub _parse_xml_response {
1182 5     5   17 my ( $self, $page, $status_code ) = @_;
1183 5         17 my $response = {};
1184 5 50       38 if ( $status_code =~ /^200/ ) {
1185 5 50       15 if ( ! eval { $response = XMLin($page); } ) {
  5         37  
1186 0         0 die "XML PARSING FAILURE: $@";
1187             }
1188             }
1189             else {
1190 0         0 $status_code =~ s/[\r\n\s]+$//; # remove newline so you can see the error in a linux console
1191 0 0       0 if ( $status_code =~ /^(?:900|599)/ ) { $status_code .= ' - verify Litle has whitelisted your IP'; }
  0         0  
1192 0         0 die "CONNECTION FAILURE: $status_code";
1193             }
1194 5         99064 return $response;
1195             }
1196              
1197             sub _parse_batch_response {
1198 0     0   0 my ( $self, $args ) = @_;
1199 0         0 my @results;
1200 0         0 my $resp = $self->{'batch_response'};
1201 0         0 $self->order_number( $resp->{'litleBatchId'} );
1202              
1203             #$self->invoice_number( $resp->{'id'} );
1204             my @result_types =
1205 0         0 grep { $_ =~ m/Response$/ }
1206 0         0 keys %{$resp}; ## get a list of result types in this batch
  0         0  
1207             return {
1208 0         0 'account_update' => $self->_get_update_response,
1209             ## do the other response types now
1210             };
1211             }
1212              
1213              
1214             sub add_item {
1215 0     0 1 0 my $self = shift;
1216             ## do we want to render it now, or later?
1217 0         0 push @{ $self->{'batch_entries'} }, shift;
  0         0  
1218             }
1219              
1220              
1221             sub create_batch {
1222 0     0 1 0 my ( $self, %opts ) = @_;
1223              
1224 0         0 local $SCRUBBER=1;
1225 0         0 $self->_litle_init(\%opts);
1226              
1227 0 0 0     0 if ( ! defined $self->{'batch_entries'} || scalar( @{ $self->{'batch_entries'} } ) < 1 ) {
  0         0  
1228 0         0 $self->error_message('Cannot create an empty batch');
1229 0         0 return;
1230             }
1231              
1232 0         0 my $post_data;
1233              
1234 0         0 my $writer = XML::Writer->new(
1235             OUTPUT => \$post_data,
1236             DATA_MODE => 1,
1237             DATA_INDENT => 2,
1238             ENCODING => 'utf-8',
1239             );
1240             ## set the authentication data
1241 0         0 tie my %authentication, 'Tie::IxHash',
1242             $self->_revmap_fields(
1243             content => \%opts,
1244             user => 'login',
1245             password => 'password',
1246             );
1247              
1248             ## Start the XML Document, parent tag
1249 0         0 $writer->xmlDecl();
1250             $writer->startTag(
1251             "litleRequest",
1252             version => $self->batch_api_version,
1253             xmlns => $self->xmlns,
1254 0   0     0 id => $opts{'batch_id'} || time,
1255             numBatchRequests => 1, #hardcoded for now, not doing multiple merchants
1256             );
1257              
1258             ## authentication
1259 0         0 $self->_xmlwrite( $writer, 'authentication', \%authentication );
1260             ## batch Request tag
1261             $writer->startTag(
1262             'batchRequest',
1263             id => $opts{'batch_id'} || time,
1264 0         0 numAccountUpdates => scalar( @{ $self->{'batch_entries'} } ),
1265 0   0     0 merchantId => $opts{'merchantid'},
1266             );
1267 0         0 foreach my $entry ( @{ $self->{'batch_entries'} } ) {
  0         0  
1268 0         0 $self->_litle_scrubber_add_card($entry->{'card_number'});
1269 0         0 my $req = $self->map_request( $entry );
1270             $writer->startTag(
1271             $entry->{'TransactionType'},
1272             id => $entry->{'invoice_number'},
1273             reportGroup => $entry->{'report_group'} || 'BOP',
1274 0   0     0 customerId => $entry->{'customer_id'} || 1,
      0        
1275             );
1276 0         0 foreach ( keys( %{$req} ) ) {
  0         0  
1277 0         0 $self->_xmlwrite( $writer, $_, $req->{$_} );
1278             }
1279 0         0 $writer->endTag( $entry->{'TransactionType'} );
1280             ## need to also handle the action tag here, and custid info
1281             }
1282 0         0 $writer->endTag("batchRequest");
1283 0         0 $writer->endTag("litleRequest");
1284 0         0 $writer->end();
1285             ## END XML Generation
1286              
1287 0         0 $self->server_request( $post_data );
1288 0 0       0 warn $self->server_request if $DEBUG;
1289              
1290             #----- Send it
1291 0 0 0     0 if ( $opts{'method'} && $opts{'method'} eq 'sftp' ) { #FTP
    0 0        
1292 0         0 my $sftp = $self->_sftp_connect(\%opts,'inbound');
1293              
1294             ## save the file out, can't put directly from var, and is multibyte, so issues from filehandle
1295 0   0     0 my $filename = $opts{'batch_id'} || $opts{'login'} . "_" . time;
1296 0         0 my $io = IO::String->new($post_data);
1297 0         0 tie *IO, 'IO::String';
1298              
1299 0 0       0 $sftp->put( $io, "$filename.prg" )
1300             or $self->_die("Cannot PUT $filename", $sftp->error);
1301 0 0       0 $sftp->rename( "$filename.prg",
1302             "$filename.asc" ) #once complete, you rename it, for pickup
1303             or $self->die("Cannot RENAME file", $sftp->error);
1304 0         0 $self->is_success(1);
1305 0         0 $self->server_response( $sftp->error );
1306             }
1307             elsif ( $opts{'method'} && $opts{'method'} eq 'https' ) { #https post
1308 0         0 $self->port('15000');
1309 0         0 $self->path('/');
1310 0         0 my ( $page, $status_code, %headers ) =
1311             $self->https_post($post_data);
1312 0         0 $self->server_response( $page );
1313              
1314 0 0       0 warn Dumper [ $page, $status_code, \%headers ] if $DEBUG;
1315              
1316 0         0 my $response = {};
1317 0 0       0 if ( $status_code =~ /^200/ ) {
1318 0 0 0     0 if ( ! eval { $response = XMLin($page); } ) {
  0 0       0  
1319 0         0 $self->_die("XML PARSING FAILURE: $@");
1320             }
1321             elsif ( exists( $response->{'response'} )
1322             && $response->{'response'} == 1 )
1323             {
1324             ## parse error type error
1325 0         0 warn Dumper( $response, $self->server_request );
1326 0         0 $self->error_message( $response->{'message'} );
1327 0         0 return;
1328             }
1329             else {
1330             $self->error_message(
1331 0         0 $response->{'batchResponse'}->{'message'} );
1332             }
1333             }
1334             else {
1335 0         0 $self->_die("CONNECTION FAILURE: $status_code");
1336             }
1337 0         0 $self->{_response} = $response;
1338              
1339             ##parse out the batch info as our general status
1340 0         0 my $resp = $response->{'batchResponse'};
1341 0         0 $self->order_number( $resp->{'litleSessionId'} );
1342 0         0 $self->result_code( $response->{'response'} );
1343 0 0       0 $self->is_success( $response->{'response'} eq '0' ? 1 : 0 );
1344              
1345 0 0       0 warn Dumper($response) if $DEBUG;
1346 0 0       0 unless ( $self->is_success() ) {
1347 0 0       0 unless ( $self->error_message() ) {
1348             $self->error_message(
1349             "(HTTPS response: $status_code) "
1350             . "(HTTPS headers: "
1351             . join( ", ",
1352 0         0 map { "$_ => " . $headers{$_} } keys %headers )
  0         0  
1353             . ") "
1354             . "(Raw HTTPS content: $page)"
1355             );
1356             }
1357             }
1358 0 0       0 if ( $self->is_success() ) {
1359 0         0 $self->{'batch_response'} = $resp;
1360             }
1361             }
1362              
1363             }
1364              
1365              
1366             sub send_rfr {
1367 0     0 1 0 my ( $self, $args ) = @_;
1368              
1369 0         0 local $SCRUBBER=1;
1370 0         0 $self->_litle_init($args);
1371              
1372 0         0 my $post_data;
1373 0         0 my $writer = XML::Writer->new(
1374             OUTPUT => \$post_data,
1375             DATA_MODE => 1,
1376             DATA_INDENT => 2,
1377             ENCODING => 'utf-8',
1378             );
1379             ## set the authentication data
1380 0         0 tie my %authentication, 'Tie::IxHash',
1381             $self->_revmap_fields(
1382             content => $args,
1383             user => 'login',
1384             password => 'password',
1385             );
1386              
1387             ## Start the XML Document, parent tag
1388 0         0 $writer->xmlDecl();
1389 0         0 $writer->startTag(
1390             "litleRequest",
1391             version => $self->batch_api_version,
1392             xmlns => $self->xmlns,
1393             numBatchRequests => 0,
1394             );
1395              
1396             ## authentication
1397 0         0 $self->_xmlwrite( $writer, 'authentication', \%authentication );
1398             ## batch Request tag
1399 0         0 $writer->startTag('RFRRequest');
1400 0         0 $writer->startTag('accountUpdateFileRequestData');
1401 0         0 $writer->startTag('merchantId');
1402 0         0 $writer->characters( $args->{'merchantid'} );
1403 0         0 $writer->endTag('merchantId');
1404 0         0 $writer->startTag('postDay');
1405 0         0 $writer->characters( $args->{'date'} );
1406 0         0 $writer->endTag('postDay');
1407 0         0 $writer->endTag('accountUpdateFileRequestData');
1408 0         0 $writer->endTag("RFRRequest");
1409 0         0 $writer->endTag("litleRequest");
1410 0         0 $writer->end();
1411             ## END XML Generation
1412             #
1413 0         0 $self->port('15000');
1414 0         0 $self->path('/');
1415 0         0 my ( $page, $status_code, %headers ) = $self->https_post($post_data);
1416              
1417 0         0 $self->server_request( $post_data );
1418 0         0 $self->server_response( $page );
1419 0 0       0 warn $self->server_request if $DEBUG;
1420              
1421 0 0       0 warn Dumper [ $page, $status_code, \%headers ] if $DEBUG;
1422              
1423 0         0 my $response = {};
1424 0 0       0 if ( $status_code =~ /^200/ ) {
1425 0 0 0     0 if ( ! eval { $response = XMLin($page); } ) {
  0 0       0  
1426 0         0 die "XML PARSING FAILURE: $@";
1427             }
1428             elsif ( exists( $response->{'response'} ) && $response->{'response'} == 1 )
1429             {
1430             ## parse error type error
1431 0         0 warn Dumper( $response, $self->server_request );
1432 0         0 $self->error_message( $response->{'message'} );
1433 0         0 return;
1434             }
1435             else {
1436 0         0 $self->error_message( $response->{'RFRResponse'}->{'message'} );
1437             }
1438             }
1439             else {
1440 0         0 die "CONNECTION FAILURE: $status_code";
1441             }
1442 0         0 $self->{_response} = $response;
1443 0 0       0 if ( $response->{'RFRResponse'} ) {
1444             ## litle returns an 'error' if the file is not done. So it's not ready yet.
1445 0         0 $self->result_code( $response->{'RFRResponse'}->{'response'} );
1446 0         0 return;
1447             }
1448             else {
1449              
1450             #if processed, it returns as a batch, so, success, and let get the details
1451 0         0 my $resp = $response->{'batchResponse'};
1452 0 0       0 $self->is_success( $resp->{'response'} eq '000' ? 1 : 0 );
1453 0         0 $self->{'batch_response'} = $resp;
1454 0         0 $self->_parse_batch_response;
1455             }
1456             }
1457              
1458             sub _sftp_connect {
1459 0     0   0 my ($self,$args,$dir) = @_;
1460 0 0       0 $self->_die("Missing ftp_username") if ! $args->{'ftp_username'};
1461 0 0       0 $self->_die("Missing ftp_password") if ! $args->{'ftp_password'};
1462 0         0 require Net::SFTP::Foreign;
1463             my $sftp = Net::SFTP::Foreign->new(
1464             $self->server(),
1465             timeout => $args->{'ftp_timeout'} || 90,
1466             stderr_discard => 1,
1467             user => $args->{'ftp_username'},
1468 0   0     0 password => $args->{'ftp_password'},
1469             );
1470 0 0       0 $sftp->error and $self->_die("SSH connection failed: " . $sftp->error);
1471              
1472 0 0       0 if ($dir) {
1473 0 0       0 $sftp->setcwd($dir)
1474             or $self->_die("Cannot change working directory ", $sftp->error);
1475             }
1476              
1477 0         0 return $sftp;
1478             }
1479              
1480             sub _die {
1481 0     0   0 my $self = shift;
1482 0         0 my $msg = join '', @_;
1483 0         0 $self->is_success(0);
1484 0         0 $self->error_message( $msg );
1485 0         0 die $msg."\n";
1486             }
1487              
1488              
1489             sub retrieve_batch_list {
1490 0     0 1 0 my ($self, %opts ) = @_;
1491              
1492 0         0 local $SCRUBBER=1;
1493 0         0 $self->_litle_init(\%opts);
1494              
1495 0         0 my $sftp = $self->_sftp_connect(\%opts,'outbound');
1496              
1497 0 0       0 my $ls = $sftp->ls( wanted => qr/\.asc$/ )
1498             or $self->_die("Cannot get directory listing ", $sftp->error);
1499              
1500 0         0 my @filenames = map {$_->{'filename'}} @{ $ls };
  0         0  
  0         0  
1501 0         0 $self->is_success(1);
1502 0         0 return \@filenames;
1503             }
1504              
1505              
1506             sub retrieve_batch_delete {
1507 0     0 1 0 my ( $self, %opts ) = @_;
1508              
1509 0         0 local $SCRUBBER=1;
1510 0         0 $self->_litle_init(\%opts);
1511              
1512 0 0       0 $self->_die("Missing batch_id") if !$opts{'batch_id'};
1513              
1514 0         0 my $sftp = $self->_sftp_connect(\%opts,'outbound');
1515              
1516 0         0 my $filename = $opts{'batch_id'};
1517 0 0       0 $sftp->remove( $filename )
1518             or $self->_die("Cannot delete $filename: ", $sftp->error);
1519              
1520 0         0 $self->is_success(1);
1521             }
1522              
1523              
1524             sub retrieve_batch {
1525 0     0 1 0 my ( $self, %opts ) = @_;
1526              
1527 0         0 local $SCRUBBER=1;
1528 0         0 $self->_litle_init(\%opts);
1529              
1530 0 0       0 $self->_die("Missing batch_id") if !$opts{'batch_id'};
1531              
1532 0         0 my $post_data;
1533 0 0       0 if ( $opts{'batch_return'} ) {
1534             ## passed in data structure
1535 0         0 $post_data = $opts{'batch_return'};
1536 0         0 $self->server_request('Data was provided using batch_return option');
1537             }
1538             else {
1539             ## go download a batch
1540 0         0 my $sftp = $self->_sftp_connect(\%opts,'outbound');
1541              
1542 0         0 my $filename = $opts{'batch_id'};
1543 0         0 $self->server_request('SFTP requesting file: '.$filename,1);
1544 0 0       0 $post_data = $sftp->get_content( $filename )
1545             or $self->_die("Cannot GET $filename", $sftp->error);
1546             }
1547 0         0 $self->server_response_dangerous($post_data,1);
1548 0         0 $self->server_response('Litle scrubber not initialized yet, see server_response_dangerous for a copy of the server response. Please note it may contain data that is not appropriate to store.',1);
1549              
1550 0         0 my $response = {};
1551 0 0 0     0 if ( ! eval { $response = XMLin($post_data,
  0 0       0  
1552             ForceArray => [ 'accountUpdateResponse' ],
1553             KeyAttr => '-id',
1554             ); } ) {
1555 0         0 $self->_die("XML PARSING FAILURE: $@");
1556             }
1557             elsif ( exists( $response->{'response'} ) && $response->{'response'} == 1 ) {
1558             ## parse error type error
1559 0         0 warn Dumper( $response, $self->{'_post_data'} );
1560 0   0     0 $self->_die($response->{'message'} || 'No reason given');
1561             }
1562             else {
1563             ## update the status
1564 0         0 $self->error_message( $response->{'batchResponse'}->{'message'} );
1565             }
1566              
1567 0         0 $self->{_response} = $response;
1568 0         0 my $resp = $response->{'batchResponse'};
1569 0         0 $self->order_number( $resp->{'litleSessionId'} );
1570 0         0 $self->result_code( $response->{'response'} );
1571 0 0       0 $self->is_success( $response->{'response'} eq '0' ? 1 : 0 );
1572 0 0       0 if ( $self->is_success() ) {
1573 0         0 $self->{'batch_response'} = $resp;
1574 0         0 return $self->_parse_batch_response;
1575             }
1576             }
1577              
1578             sub _get_update_response {
1579 0     0   0 my $self = shift;
1580 0         0 require Business::OnlinePayment::Litle::UpdaterResponse;
1581 0         0 my @response;
1582 0         0 foreach
1583 0         0 my $item ( @{ $self->{'batch_response'}->{'accountUpdateResponse'} } )
1584             {
1585 0         0 push @response,
1586             Business::OnlinePayment::Litle::UpdaterResponse->new( $item );
1587             }
1588 0         0 return \@response;
1589             }
1590              
1591             sub _revmap_fields {
1592 160     160   285 my $self = shift;
1593 160         485 tie my (%map), 'Tie::IxHash', @_;
1594 160         14366 my %content;
1595 160 50 33     502 if ( $map{'content'} && ref( $map{'content'} ) eq 'HASH' ) {
1596 160         1910 %content = %{ delete( $map{'content'} ) };
  160         481  
1597             }
1598             else {
1599 0         0 warn "WARNING: This content has not been pre-processed with map_fields ";
1600 0         0 %content = $self->content();
1601             }
1602              
1603             map {
1604 160         6611 my $value;
  933         5499  
1605 933 100       2339 if ( ref( $map{$_} ) eq 'HASH' ) {
    100          
    50          
    100          
1606 106 100       592 $value = $map{$_} if ( keys %{ $map{$_} } );
  106         269  
1607             }
1608             elsif ( ref( $map{$_} ) eq 'ARRAY' ) {
1609 6         65 $value = $map{$_};
1610             }
1611             elsif ( ref( $map{$_} ) ) {
1612 0         0 $value = ${ $map{$_} };
  0         0  
1613             }
1614             elsif ( exists( $content{ $map{$_} } ) ) {
1615 348         6921 $value = $content{ $map{$_} };
1616             }
1617              
1618 933 100       13821 if ( defined($value) ) {
1619 399         1250 ( $_ => $value );
1620             }
1621             else {
1622 534         1708 ();
1623             }
1624             } ( keys %map );
1625             }
1626              
1627             sub _xmlwrite {
1628 344     344   796 my ( $self, $writer, $item, $value ) = @_;
1629 344 100       2135 if ( ref($value) eq 'HASH' ) {
    100          
1630 60 50       168 my $attr = $value->{'attr'} ? $value->{'attr'} : {};
1631 60         366 $writer->startTag( $item, %{$attr} );
  60         204  
1632 60         3118 foreach ( keys(%$value) ) {
1633 264 50       6071 next if $_ eq 'attr';
1634 264         685 $self->_xmlwrite( $writer, $_, $value->{$_} );
1635             }
1636 60         1531 $writer->endTag($item);
1637             }
1638             elsif ( ref($value) eq 'ARRAY' ) {
1639 5         11 foreach ( @{$value} ) {
  5         14  
1640 10         189 $self->_xmlwrite( $writer, $item, $_ );
1641             }
1642             }
1643             else {
1644 279         636 $writer->startTag($item);
1645 279         13662 $writer->characters($value);
1646 279         5578 $writer->endTag($item);
1647             }
1648             }
1649              
1650             sub _default_scrubber {
1651 9     9   782 my $cc = shift;
1652 9         39 my $del = substr($cc,0,6).('X'x(length($cc)-10)).substr($cc,-4,4); # show first 6 and last 4
1653 9         36 return $del;
1654             }
1655              
1656             sub _litle_scrubber_add_card {
1657 7     7   95 my ( $self, $cc ) = @_;
1658 7 100       26 return if ! $cc;
1659 5         13 my $scrubber = $self->{_scrubber};
1660 5         10 scrubber_add_scrubber({$cc=>&{$scrubber}($cc)});
  5         13  
1661             }
1662              
1663             sub _litle_init {
1664 6     6   18 my ( $self, $opts ) = @_;
1665              
1666             # initialize/reset the reporting methods
1667 6         145 $self->is_success(0);
1668 6         67 $self->server_request('');
1669 6         25 $self->server_response('');
1670 6         131 $self->error_message('');
1671              
1672             # some calls are passed via the content method, others are direct arguments... this way we cover both
1673 6         63 my %content = $self->content();
1674 6         160 foreach my $ptr (\%content,$opts) {
1675 12 100       69 next if ! $ptr;
1676             scrubber_init({
1677             quotemeta($ptr->{'password'}||'')=>'DELETED',
1678             quotemeta($ptr->{'ftp_password'}||'')=>'DELETED',
1679 6 50 50     96 ($ptr->{'cvv2'} ? '(?<=[^\d])'.quotemeta($ptr->{'cvv2'}).'(?=[^\d])' : '')=>'DELETED',
      50        
1680             });
1681 6         1415 $self->_litle_scrubber_add_card($ptr->{'card_number'});
1682             }
1683             }
1684              
1685              
1686             sub chargeback_activity_request {
1687 0     0 1   my ( $self ) = @_;
1688              
1689 0           local $SCRUBBER=1;
1690 0           $self->_litle_init;
1691              
1692 0           my $post_data;
1693 0           my %content = $self->content();
1694              
1695             ## activity_date
1696             ## Type = Date; Format = YYYY-MM-DD
1697 0 0 0       if ( ! $content{'activity_date'} || $content{'activity_date'} !~ m/^\d{4}-(\d{2})-(\d{2})$/ || $1 > 12 || $2 > 31) {
      0        
      0        
1698 0   0       $self->_die("Invalid Date Pattern, YYYY-MM-DD required:" . ( $content{'activity_date'} || 'undef'));
1699             }
1700             #
1701             ## financials only [true,false]
1702             # The financialOnly element is an optional child of the litleChargebackActivitiesRequest element.
1703             # You use this flag in combination with the activityDate element to specify a request for chargeback financial activities that occurred on the specified date.
1704             # A value of true returns only activities that had financial impact on the specified date.
1705             # A value of false returns all activities on the specified date.
1706             #Type = Boolean; Valid Values = true or false
1707 0           my $financials;
1708 0 0         if ( defined( $content{'financial_only'} ) ) {
1709 0 0         $financials = $content{'financial_only'} ? 'true' : 'false';
1710             }
1711             else {
1712 0           $financials = 'false';
1713             }
1714              
1715 0           my $writer = XML::Writer->new(
1716             OUTPUT => \$post_data,
1717             DATA_MODE => 1,
1718             DATA_INDENT => 2,
1719             ENCODING => 'utf-8',
1720             );
1721             ## set the authentication data
1722 0           tie my %authentication, 'Tie::IxHash',
1723             $self->_revmap_fields(
1724             content => \%content,
1725             user => 'login',
1726             password => 'password',
1727             );
1728              
1729             ## Start the XML Document, parent tag
1730 0           $writer->xmlDecl();
1731 0           $writer->startTag(
1732             "litleChargebackActivitiesRequest",
1733             version => $self->chargeback_api_version,
1734             xmlns => $self->xmlns,
1735             );
1736              
1737             ## authentication
1738 0           $self->_xmlwrite( $writer, 'authentication', \%authentication );
1739             ## batch Request tag
1740 0           $writer->startTag('activityDate');
1741 0           $writer->characters( $content{'activity_date'} );
1742 0           $writer->endTag('activityDate');
1743 0           $writer->startTag('financialOnly');
1744 0           $writer->characters($financials);
1745 0           $writer->endTag('financialOnly');
1746 0           $writer->endTag("litleChargebackActivitiesRequest");
1747 0           $writer->end();
1748             ## END XML Generation
1749              
1750 0           $self->{'_post_data'} = $post_data;
1751 0 0         warn $self->{'_post_data'} if $DEBUG;
1752             #my ( $page, $status_code, %headers ) = $self->https_post( { 'Content-Type' => 'text/xml; charset=utf-8' } , $post_data);
1753 0           my $url = 'https://'.$self->chargeback_server.':'.$self->chargeback_port.'/'.$self->chargeback_path;
1754 0           my $tiny_response = HTTP::Tiny->new( verify_SSL=>$self->verify_SSL )->request('POST', $url, {
1755             headers => { 'Content-Type' => 'text/xml; charset=utf-8', },
1756             content => $post_data,
1757             } );
1758              
1759 0           my $page = $tiny_response->{'content'};
1760 0           $self->server_request( $post_data );
1761 0           $self->server_response( $page );
1762 0           my $status_code = $tiny_response->{'status'};
1763 0           my %headers = %{$tiny_response->{'headers'}};
  0            
1764              
1765 0 0         warn Dumper $page, $status_code, \%headers if $DEBUG;
1766              
1767 0           my $response = {};
1768 0 0         if ( $status_code =~ /^200/ ) {
1769             ## Failed to parse
1770 0 0 0       if ( !eval { $response = XMLin($page,
  0 0          
1771             ForceArray => [ 'caseActivity' ],
1772             ); } ) {
1773 0           $self->_die("XML PARSING FAILURE: $@, $page");
1774             } ## well-formed failure message
1775             elsif ( exists( $response->{'response'} )
1776             && $response->{'response'} == 1 )
1777             {
1778             ## parse error type error
1779 0           warn Dumper( $response, $self->{'_post_data'} );
1780 0           $self->error_message( $response->{'message'} );
1781 0           return;
1782             } ## success message
1783             else {
1784             $self->error_message(
1785 0           $response->{'litleChargebackActivitiesResponse'}->{'message'} );
1786             }
1787             }
1788             else {
1789 0           $status_code =~ s/[\r\n\s]+$//
1790             ; # remove newline so you can see the error in a linux console
1791 0 0         if ( $status_code =~ /^(?:900|599)/ ) {
1792 0           $status_code .= ' - verify Litle has whitelisted your IP';
1793             }
1794 0           $self->_die("CONNECTION FAILURE: $status_code");
1795             }
1796 0           $self->{_response} = $response;
1797              
1798 0           my @response_list;
1799 0           require Business::OnlinePayment::Litle::ChargebackActivityResponse;
1800 0           foreach my $case ( @{ $response->{caseActivity} } ) {
  0            
1801 0           push @response_list,
1802             Business::OnlinePayment::Litle::ChargebackActivityResponse->new($case);
1803             }
1804              
1805 0 0         warn Dumper($response) if $DEBUG;
1806 0           $self->is_success(1);
1807 0           return \@response_list;
1808             }
1809              
1810              
1811             sub chargeback_update_request {
1812 0     0 1   my ( $self ) = @_;
1813              
1814 0           local $SCRUBBER=1;
1815 0           $self->_litle_init;
1816              
1817 0           my $post_data;
1818 0           my %content = $self->content();
1819              
1820 0           foreach my $key (qw(case_id merchant_activity_id activity )) {
1821             ## case_id
1822             ## merchant_activity_id
1823             ## activity
1824 0 0         croak "Missing arg $key" unless $content{$key};
1825             }
1826              
1827 0           my $writer = XML::Writer->new(
1828             OUTPUT => \$post_data,
1829             DATA_MODE => 1,
1830             DATA_INDENT => 2,
1831             ENCODING => 'utf-8',
1832             );
1833             ## set the authentication data
1834 0           tie my %authentication, 'Tie::IxHash',
1835             $self->_revmap_fields(
1836             content => \%content,
1837             user => 'login',
1838             password => 'password',
1839             );
1840              
1841             ## Start the XML Document, parent tag
1842 0           $writer->xmlDecl();
1843 0           $writer->startTag(
1844             "litleChargebackUpdateRequest",
1845             version => $self->chargeback_api_version,
1846             xmlns => $self->xmlns,
1847             );
1848              
1849             ## authentication
1850 0           $self->_xmlwrite( $writer, 'authentication', \%authentication );
1851 0           $writer->startTag('caseUpdate');
1852 0           $writer->startTag('caseId');
1853 0           $writer->characters( $content{'case_id'} );
1854 0           $writer->endTag('caseId');
1855              
1856 0           $writer->startTag('merchantActivityId');
1857 0           $writer->characters( $content{'merchant_activity_id'} );
1858 0           $writer->endTag('merchantActivityId');
1859              
1860 0           $writer->startTag('activity');
1861 0           $writer->characters( $content{'activity'} );
1862 0           $writer->endTag('activity');
1863              
1864 0           $writer->endTag('caseUpdate');
1865 0           $writer->endTag("litleChargebackUpdateRequest");
1866 0           $writer->end();
1867             ## END XML Generation
1868              
1869 0           $self->{'_post_data'} = $post_data;
1870 0 0         warn $self->{'_post_data'} if $DEBUG;
1871             #my ( $page, $status_code, %headers ) = $self->https_post($post_data);
1872 0           my $url = 'https://'.$self->chargeback_server.':'.$self->chargeback_port.'/'.$self->chargeback_path;
1873 0           my $tiny_response = HTTP::Tiny->new( verify_SSL=>$self->verify_SSL )->request('POST', $url, {
1874             headers => { 'Content-Type' => 'text/xml; charset=utf-8', },
1875             content => $post_data,
1876             } );
1877              
1878 0           my $page = $tiny_response->{'content'};
1879 0           $self->server_response( $page );
1880 0           my $status_code = $tiny_response->{'status'};
1881 0           my %headers = %{$tiny_response->{'headers'}};
  0            
1882              
1883 0 0         warn Dumper $page, $status_code, \%headers if $DEBUG;
1884              
1885 0           my $response = {};
1886 0 0         if ( $status_code =~ /^200/ ) {
1887             ## Failed to parse
1888 0 0         if ( !eval { $response = XMLin($page); } ) {
  0            
1889 0           die "XML PARSING FAILURE: $@, $page";
1890             } ## well-formed failure message
1891 0           $self->{_response} = $response;
1892 0 0         if ( exists( $response->{'response'} ) ) {
1893             ## parse error type error
1894 0           warn Dumper( $response, $self->{'_post_data'} );
1895 0           $self->result_code( $response->{'response'} ); # 0 - success, 1 invalid xml
1896 0           $self->error_message( $response->{'message'} );
1897 0           $self->phoenixTxnId( $response->{'caseUpdateResponse'}{'phoenixTxnId'} );
1898 0           $self->is_success(1);
1899 0           return $response->{'caseUpdateResponse'}{'phoenixTxnId'};
1900             }
1901             else {
1902 0           die "UNKNOWN XML RESULT: $page";
1903             }
1904             }
1905             else {
1906 0           $status_code =~ s/[\r\n\s]+$//
1907             ; # remove newline so you can see the error in a linux console
1908 0 0         if ( $status_code =~ /^(?:900|599)/ ) {
1909 0           $status_code .= ' - verify Litle has whitelisted your IP';
1910             }
1911 0           die "CONNECTION FAILURE: $status_code";
1912             }
1913             }
1914              
1915              
1916              
1917             1; # End of Business::OnlinePayment::Litle
1918              
1919             __END__