quiet warnings about CGI::param in list context
[freeside.git] / FS / FS / cust_pay_batch.pm
1 package FS::cust_pay_batch;
2 use base qw( FS::payinfo_Mixin FS::cust_main_Mixin FS::Record );
3
4 use strict;
5 use vars qw( $DEBUG );
6 use Carp qw( carp confess );
7 use Business::CreditCard 0.28;
8 use FS::Record qw(dbh qsearch qsearchs);
9
10 # 1 is mostly method/subroutine entry and options
11 # 2 traces progress of some operations
12 # 3 is even more information including possibly sensitive data
13 $DEBUG = 0;
14
15 #@encrypted_fields = ('payinfo');
16 sub nohistory_fields { ('payinfo'); }
17
18 =head1 NAME
19
20 FS::cust_pay_batch - Object methods for batch cards
21
22 =head1 SYNOPSIS
23
24   use FS::cust_pay_batch;
25
26   $record = new FS::cust_pay_batch \%hash;
27   $record = new FS::cust_pay_batch { 'column' => 'value' };
28
29   $error = $record->insert;
30
31   $error = $new_record->replace($old_record);
32
33   $error = $record->delete;
34
35   $error = $record->check;
36
37   #deprecated# $error = $record->retriable;
38
39 =head1 DESCRIPTION
40
41 An FS::cust_pay_batch object represents a credit card transaction ready to be
42 batched (sent to a processor).  FS::cust_pay_batch inherits from FS::Record.  
43 Typically called by the collect method of an FS::cust_main object.  The
44 following fields are currently supported:
45
46 =over 4
47
48 =item paybatchnum - primary key (automatically assigned)
49
50 =item batchnum - indentifies group in batch
51
52 =item payby - CARD/CHEK
53
54 =item payinfo
55
56 =item exp - card expiration 
57
58 =item amount 
59
60 =item invnum - invoice
61
62 =item custnum - customer 
63
64 =item payname - name on card 
65
66 =item paytype - account type ((personal|business) (checking|savings))
67
68 =item first - name 
69
70 =item last - name 
71
72 =item address1 
73
74 =item address2 
75
76 =item city 
77
78 =item state 
79
80 =item zip 
81
82 =item country 
83
84 =item status - 'Approved' or 'Declined'
85
86 =item error_message - the error returned by the gateway if any
87
88 =item failure_status - the normalized L<Business::BatchPayment> failure 
89 status, if any
90
91 =back
92
93 =head1 METHODS
94
95 =over 4
96
97 =item new HASHREF
98
99 Creates a new record.  To add the record to the database, see L<"insert">.
100
101 Note that this stores the hash reference, not a distinct copy of the hash it
102 points to.  You can ask the object for a copy with the I<hash> method.
103
104 =cut
105
106 sub table { 'cust_pay_batch'; }
107
108 =item insert
109
110 Adds this record to the database.  If there is an error, returns the error,
111 otherwise returns false.
112
113 =item delete
114
115 Delete this record from the database.  If there is an error, returns the error,
116 otherwise returns false.
117
118 =item replace OLD_RECORD
119
120 Replaces the OLD_RECORD with this one in the database.  If there is an error,
121 returns the error, otherwise returns false.
122
123 =item check
124
125 Checks all fields to make sure this is a valid transaction.  If there is
126 an error, returns the error, otherwise returns false.  Called by the insert
127 and replace methods.
128
129 =cut
130
131 sub check {
132   my $self = shift;
133
134   my $conf = new FS::Conf;
135
136   my $error = 
137       $self->ut_numbern('paybatchnum')
138     || $self->ut_numbern('trancode') #deprecated
139     || $self->ut_money('amount')
140     || $self->ut_number('invnum')
141     || $self->ut_number('custnum')
142     || $self->ut_text('address1')
143     || $self->ut_textn('address2')
144     || ($conf->exists('cust_main-no_city_in_address') 
145         ? $self->ut_textn('city') 
146         : $self->ut_text('city'))
147     || $self->ut_textn('state')
148   ;
149
150   return $error if $error;
151
152   $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name";
153   $self->setfield('last',$1);
154
155   $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name";
156   $self->first($1);
157
158   $error = $self->payinfo_check();
159   return $error if $error;
160
161   if ( $self->payby eq 'CHEK' ) {
162     # because '' is on the list of paytypes:
163     my $paytype = $self->paytype or return "Bank account type required";
164     if (grep { $_ eq $paytype} FS::cust_payby->paytypes) {
165       #ok
166     } else {
167       return "Bank account type '$paytype' is not allowed"
168     }
169   } else {
170     $self->set('paytype', '');
171   }
172
173   if ( $self->exp eq '' ) {
174     return "Expiration date required"
175       unless $self->payby =~ /^(CHEK|DCHK|WEST)$/;
176     $self->exp('');
177   } else {
178     if ( $self->exp =~ /^(\d{4})[\/\-](\d{1,2})[\/\-](\d{1,2})$/ ) {
179       $self->exp("$1-$2-$3");
180     } elsif ( $self->exp =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
181       if ( length($2) == 4 ) {
182         $self->exp("$2-$1-01");
183       } elsif ( $2 > 98 ) { #should pry change to check for "this year"
184         $self->exp("19$2-$1-01");
185       } else {
186         $self->exp("20$2-$1-01");
187       }
188     } else {
189       return "Illegal expiration date";
190     }
191   }
192
193   if ( $self->payname eq '' ) {
194     $self->payname( $self->first. " ". $self->getfield('last') );
195   } else {
196     $self->payname =~ /^([\w \,\.\-\']+)$/
197       or return "Illegal billing name";
198     $self->payname($1);
199   }
200
201   #we have lots of old zips in there... don't hork up batch results cause of em
202   $self->zip =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
203     or return "Illegal zip: ". $self->zip;
204   $self->zip($1);
205
206   $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
207   $self->country($1);
208
209   #$error = $self->ut_zip('zip', $self->country);
210   #return $error if $error;
211
212   #check invnum, custnum, ?
213
214   $self->SUPER::check;
215 }
216
217 =item cust_main
218
219 Returns the customer (see L<FS::cust_main>) for this batched credit card
220 payment.
221
222 =item expmmyy
223
224 Returns the credit card expiration date in MMYY format.  If this is a 
225 CHEK payment, returns an empty string.
226
227 =cut
228
229 sub expmmyy {
230   my $self = shift;
231   if ( $self->payby eq 'CARD' ) {
232     $self->get('exp') =~ /^(\d{4})-(\d{2})-(\d{2})$/;
233     return sprintf('%02u%02u', $2, ($1 % 100));
234   }
235   else {
236     return '';
237   }
238 }
239
240 =item pay_batch
241
242 Returns the payment batch this payment belongs to (L<FS::pay_batch>).
243
244 =cut
245
246 #you know what, screw this in the new world of events.  we should be able to
247 #get the event defs to retry (remove once.pm condition, add every.pm) without
248 #mucking about with statuses of previous cust_event records.  right?
249 #
250 #=item retriable
251 #
252 #Marks the corresponding event (see L<FS::cust_bill_event>) for this batched
253 #credit card payment as retriable.  Useful if the corresponding financial
254 #institution account was declined for temporary reasons and/or a manual 
255 #retry is desired.
256 #
257 #Implementation details: For the named customer's invoice, changes the
258 #statustext of the 'done' (without statustext) event to 'retriable.'
259 #
260 #=cut
261
262 sub retriable {
263
264   confess "deprecated method cust_pay_batch->retriable called; try removing ".
265           "the once condition and adding an every condition?";
266
267 }
268
269 =item approve OPTIONS
270
271 Approve this payment.  This will replace the existing record with the 
272 same paybatchnum, set its status to 'Approved', and generate a payment 
273 record (L<FS::cust_pay>).  This should only be called from the batch 
274 import process.
275
276 OPTIONS may contain "gatewaynum", "processor", "auth", and "order_number".
277
278 =cut
279
280 sub approve {
281   # to break up the Big Wall of Code that is import_results
282   my $new = shift;
283   my %opt = @_;
284   my $paybatchnum = $new->paybatchnum;
285   my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum })
286     or return "cannot approve, paybatchnum $paybatchnum not found";
287   # leave these restrictions in place until TD EFT is converted over
288   # to B::BP
289   return "cannot approve paybatchnum $paybatchnum, already resolved ('".$old->status."')" 
290     if $old->status;
291   $new->status('Approved');
292   my $error = $new->replace($old);
293   if ( $error ) {
294     return "error approving paybatchnum $paybatchnum: $error\n";
295   }
296
297   return if $new->paycode eq "C";
298
299   my $cust_pay = new FS::cust_pay ( {
300       'custnum'   => $new->custnum,
301       'payby'     => $new->payby,
302       'payinfo'   => $new->payinfo || $old->payinfo,
303       'paymask'   => $new->mask_payinfo,
304       'paid'      => $new->paid,
305       '_date'     => $new->_date,
306       'usernum'   => $new->usernum,
307       'batchnum'  => $new->batchnum,
308       'invnum'    => $old->invnum,
309       'gatewaynum'    => $opt{'gatewaynum'},
310       'processor'     => $opt{'processor'},
311       'auth'          => $opt{'auth'},
312       'order_number'  => $opt{'order_number'} 
313     } );
314
315   $error = $cust_pay->insert;
316   if ( $error ) {
317     return "error inserting payment for paybatchnum $paybatchnum: $error\n";
318   }
319   $cust_pay->cust_main->apply_payments;
320   return;
321 }
322
323 =item decline [ REASON [ STATUS ] ]
324
325 Decline this payment.  This will replace the existing record with the 
326 same paybatchnum, set its status to 'Declined', and run collection events
327 as appropriate.  This should only be called from the batch import process.
328
329 REASON is a string description of the decline reason, defaulting to 
330 'Returned payment', and will go into the "error_message" field.
331
332 STATUS is a normalized failure status defined by L<Business::BatchPayment>,
333 and will go into the "failure_status" field.
334
335 =cut
336
337 sub decline {
338   my $new = shift;
339   my $reason = shift || 'Returned payment';
340   my $failure_status = shift || '';
341   #my $conf = new FS::Conf;
342
343   my $paybatchnum = $new->paybatchnum;
344   my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum })
345     or return "cannot decline, paybatchnum $paybatchnum not found";
346   if ( $old->status ) {
347     # Handle the case where payments are rejected after the batch has been 
348     # approved.  FS::pay_batch::import_results won't allow results to be 
349     # imported to a closed batch unless batch-manual_approval is enabled, 
350     # so we don't check it here.
351 #    if ( $conf->exists('batch-manual_approval') and
352     if ( lc($old->status) eq 'approved' ) {
353       # Void the payment
354       my $cust_pay = qsearchs('cust_pay', { 
355           custnum  => $new->custnum,
356           batchnum => $new->batchnum
357         });
358       # these should all be migrated over, but if it's not found, look for
359       # batchnum in the 'paybatch' field also
360       $cust_pay ||= qsearchs('cust_pay', { 
361           custnum  => $new->custnum,
362           paybatch => $new->batchnum
363         });
364       if ( !$cust_pay ) {
365         # should never happen...
366         return "failed to revoke paybatchnum $paybatchnum, payment not found";
367       }
368       $cust_pay->void($reason);
369     }
370     else {
371       # normal case: refuse to do anything
372       return "cannot decline paybatchnum $paybatchnum, already resolved ('".$old->status."')";
373     }
374   } # !$old->status
375   $new->status('Declined');
376   $new->error_message($reason);
377   $new->failure_status($failure_status);
378   my $error = $new->replace($old);
379   if ( $error ) {
380     return "error declining paybatchnum $paybatchnum: $error\n";
381   }
382   my $due_cust_event = $new->cust_main->due_cust_event(
383     'eventtable'  => 'cust_pay_batch',
384     'objects'     => [ $new ],
385   );
386   if ( !ref($due_cust_event) ) {
387     return $due_cust_event;
388   }
389   # XXX breaks transaction integrity
390   foreach my $cust_event (@$due_cust_event) {
391     next unless $cust_event->test_conditions;
392     if ( my $error = $cust_event->do_event() ) {
393       return $error;
394     }
395   }
396   return;
397 }
398
399 =item request_item [ OPTIONS ]
400
401 Returns a L<Business::BatchPayment::Item> object for this batch payment
402 entry.  This can be submitted to a processor.
403
404 OPTIONS can be a list of key/values to append to the attributes.  The most
405 useful case of this is "process_date" to set a processing date based on the
406 date the batch is being submitted.
407
408 =cut
409
410 sub request_item {
411   local $@;
412   my $self = shift;
413
414   eval "use Business::BatchPayment;";
415   die "couldn't load Business::BatchPayment: $@" if $@;
416
417   my $cust_main = $self->cust_main;
418   my $location = $cust_main->bill_location;
419   my $pay_batch = $self->pay_batch;
420
421   my %payment;
422   $payment{payment_type} = FS::payby->payby2bop( $pay_batch->payby );
423   if ( $payment{payment_type} eq 'CC' ) {
424     $payment{card_number} = $self->payinfo,
425     $payment{expiration}  = $self->expmmyy,
426   } elsif ( $payment{payment_type} eq 'ECHECK' ) {
427     $self->payinfo =~ /(\d+)@(\d+)/; # or else what?
428     $payment{account_number} = $1;
429     $payment{routing_code} = $2;
430     $payment{account_type} = $self->paytype;
431     # XXX what if this isn't their regular payment method?
432   } else {
433     die "unsupported BatchPayment method: ".$pay_batch->payby;
434   }
435
436   my $recurring;
437   if ( $cust_main->status =~ /^active|suspended|ordered$/ ) {
438     if ( $self->payinfo_used ) {
439       $recurring = 'S'; # subsequent
440     } else {
441       $recurring = 'F'; # first use
442     }
443   } else {
444     $recurring = 'N'; # non-recurring
445   }
446
447   Business::BatchPayment->create(Item =>
448     # required
449     action      => 'payment',
450     tid         => $self->paybatchnum,
451     amount      => $self->amount,
452
453     # customer info
454     customer_id => $self->custnum,
455     first_name  => $cust_main->first,
456     last_name   => $cust_main->last,
457     company     => $cust_main->company,
458     address     => $location->address1,
459     ( map { $_ => $location->$_ } qw(address2 city state country zip) ),
460     
461     invoice_number  => $self->invnum,
462     recurring_billing => $recurring,
463     %payment,
464   );
465 }
466
467 =item process_unbatch_and_delete
468
469 L</unbatch_and_delete> run as a queued job, accepts I<$job> and I<$param>.
470
471 =cut
472
473 sub process_unbatch_and_delete {
474   my ($job, $param) = @_;
475   my $self = qsearchs('cust_pay_batch',{ 'paybatchnum' => scalar($param->{'paybatchnum'}) })
476     or die 'Could not find paybatchnum ' . $param->{'paybatchnum'};
477   my $error = $self->unbatch_and_delete;
478   die $error if $error;
479   return '';
480 }
481
482 =item unbatch_and_delete
483
484 May only be called on a record with an empty status and an associated
485 L<FS::pay_batch> with a status of 'O' (not yet in transit.)  Deletes all associated
486 records from L<FS::cust_bill_pay_batch> and then deletes this record.
487 If there is an error, returns the error, otherwise returns false.
488
489 =cut
490
491 sub unbatch_and_delete {
492   my $self = shift;
493
494   return 'Cannot unbatch a cust_pay_batch with status ' . $self->status
495     if $self->status;
496
497   my $pay_batch = qsearchs('pay_batch',{ 'batchnum' => $self->batchnum })
498     or return 'Cannot find associated pay_batch record';
499
500   return 'Cannot unbatch from a pay_batch with status ' . $pay_batch->status
501     if $pay_batch->status ne 'O';
502
503   local $SIG{HUP} = 'IGNORE';
504   local $SIG{INT} = 'IGNORE';
505   local $SIG{QUIT} = 'IGNORE';
506   local $SIG{TERM} = 'IGNORE';
507   local $SIG{TSTP} = 'IGNORE';
508   local $SIG{PIPE} = 'IGNORE';
509
510   my $oldAutoCommit = $FS::UID::AutoCommit;
511   local $FS::UID::AutoCommit = 0;
512   my $dbh = dbh;
513
514   # have not generated actual payments yet, so should be safe to delete
515   foreach my $cust_bill_pay_batch ( 
516     qsearch('cust_bill_pay_batch',{ 'paybatchnum' => $self->paybatchnum })
517   ) {
518     my $error = $cust_bill_pay_batch->delete;
519     if ( $error ) {
520       $dbh->rollback if $oldAutoCommit;
521       return $error;
522     }
523   }
524
525   my $error = $self->delete;
526   if ( $error ) {
527     $dbh->rollback if $oldAutoCommit;
528     return $error;
529   }
530
531   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
532   '';
533
534 }
535
536 =item cust_bill
537
538 Returns the invoice linked to this batched payment. Deprecated, will be 
539 removed.
540
541 =cut
542
543 sub cust_bill {
544   carp "FS::cust_pay_batch->cust_bill is deprecated";
545   my $self = shift;
546   $self->invnum ? qsearchs('cust_bill', { invnum => $self->invnum }) : '';
547 }
548
549 =back
550
551 =head1 BUGS
552
553 There should probably be a configuration file with a list of allowed credit
554 card types.
555
556 =head1 SEE ALSO
557
558 L<FS::cust_main>, L<FS::Record>
559
560 =cut
561
562 1;
563