add ignore_noapply flag to make sure payments are forced in anyway on import
[freeside.git] / FS / FS / cust_pay.pm
1 package FS::cust_pay;
2
3 use strict;
4 use vars qw( @ISA $conf $unsuspendauto $ignore_noapply );
5 use Date::Format;
6 use Business::CreditCard;
7 use Text::Template;
8 use FS::Record qw( dbh qsearch qsearchs );
9 use FS::Misc qw(send_email);
10 use FS::cust_bill;
11 use FS::cust_bill_pay;
12 use FS::cust_pay_refund;
13 use FS::cust_main;
14 use FS::cust_pay_void;
15
16 @ISA = qw( FS::Record );
17
18 $ignore_noapply = 0;
19
20 #ask FS::UID to run this stuff for us later
21 FS::UID->install_callback( sub { 
22   $conf = new FS::Conf;
23   $unsuspendauto = $conf->exists('unsuspendauto');
24 } );
25
26 =head1 NAME
27
28 FS::cust_pay - Object methods for cust_pay objects
29
30 =head1 SYNOPSIS
31
32   use FS::cust_pay;
33
34   $record = new FS::cust_pay \%hash;
35   $record = new FS::cust_pay { 'column' => 'value' };
36
37   $error = $record->insert;
38
39   $error = $new_record->replace($old_record);
40
41   $error = $record->delete;
42
43   $error = $record->check;
44
45 =head1 DESCRIPTION
46
47 An FS::cust_pay object represents a payment; the transfer of money from a
48 customer.  FS::cust_pay inherits from FS::Record.  The following fields are
49 currently supported:
50
51 =over 4
52
53 =item paynum - primary key (assigned automatically for new payments)
54
55 =item custnum - customer (see L<FS::cust_main>)
56
57 =item paid - Amount of this payment
58
59 =item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
60 L<Time::Local> and L<Date::Parse> for conversion functions.
61
62 =item payby - `CARD' (credit cards), `CHEK' (electronic check/ACH),
63 `LECB' (phone bill billing), `BILL' (billing), or `COMP' (free)
64
65 =item payinfo - card number, check #, or comp issuer (4-8 lowercase alphanumerics; think username), respectively
66
67 =item paybatch - text field for tracking card processing
68
69 =item closed - books closed flag, empty or `Y'
70
71 =back
72
73 =head1 METHODS
74
75 =over 4 
76
77 =item new HASHREF
78
79 Creates a new payment.  To add the payment to the databse, see L<"insert">.
80
81 =cut
82
83 sub table { 'cust_pay'; }
84
85 =item insert
86
87 Adds this payment to the database.
88
89 For backwards-compatibility and convenience, if the additional field invnum
90 is defined, an FS::cust_bill_pay record for the full amount of the payment
91 will be created.  In this case, custnum is optional.
92
93 =cut
94
95 sub insert {
96   my $self = shift;
97
98   local $SIG{HUP} = 'IGNORE';
99   local $SIG{INT} = 'IGNORE';
100   local $SIG{QUIT} = 'IGNORE';
101   local $SIG{TERM} = 'IGNORE';
102   local $SIG{TSTP} = 'IGNORE';
103   local $SIG{PIPE} = 'IGNORE';
104
105   my $oldAutoCommit = $FS::UID::AutoCommit;
106   local $FS::UID::AutoCommit = 0;
107   my $dbh = dbh;
108
109   if ( $self->invnum ) {
110     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
111       or do {
112         $dbh->rollback if $oldAutoCommit;
113         return "Unknown cust_bill.invnum: ". $self->invnum;
114       };
115     $self->custnum($cust_bill->custnum );
116   }
117
118   my $cust_main = $self->cust_main;
119   my $old_balance = $cust_main->balance;
120
121   my $error = $self->check;
122   return $error if $error;
123
124   $error = $self->SUPER::insert;
125   if ( $error ) {
126     $dbh->rollback if $oldAutoCommit;
127     return "error inserting $self: $error";
128   }
129
130   if ( $self->invnum ) {
131     my $cust_bill_pay = new FS::cust_bill_pay {
132       'invnum' => $self->invnum,
133       'paynum' => $self->paynum,
134       'amount' => $self->paid,
135       '_date'  => $self->_date,
136     };
137     $error = $cust_bill_pay->insert;
138     if ( $error ) {
139       if ( $ignore_noapply ) {
140         warn "warning: error inserting $cust_bill_pay: $error ".
141              "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
142       } else {
143         $dbh->rollback if $oldAutoCommit;
144         return "error inserting $cust_bill_pay: $error";
145       }
146     }
147   }
148
149   if ( $self->paybatch =~ /^webui-/ ) {
150     my @cust_pay = qsearch('cust_pay', {
151       'custnum' => $self->custnum,
152       'paybatch' => $self->paybatch,
153     } );
154     if ( scalar(@cust_pay) > 1 ) {
155       $dbh->rollback if $oldAutoCommit;
156       return "a payment with webui token ". $self->paybatch. " already exists";
157     }
158   }
159
160   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
161
162   #false laziness w/ cust_credit::insert
163   if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
164     my @errors = $cust_main->unsuspend;
165     #return 
166     # side-fx with nested transactions?  upstack rolls back?
167     warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
168          join(' / ', @errors)
169       if @errors;
170   }
171   #eslaf
172
173   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
174
175   #my $cust_main = $self->cust_main;
176   if ( $conf->exists('payment_receipt_email')
177        && grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list
178   ) {
179
180     my $receipt_template = new Text::Template (
181       TYPE   => 'ARRAY',
182       SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
183     ) or do {
184       warn "can't create payment receipt template: $Text::Template::ERROR";
185       return '';
186     };
187
188     my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list;
189
190     my $payby = $self->payby;
191     my $payinfo = $self->payinfo;
192     $payby =~ s/^BILL$/Check/ if $payinfo;
193     $payinfo = $self->payinfo_masked if $payby eq 'CARD' || $payby eq 'CHEK';
194     $payby =~ s/^CHEK$/Electronic check/;
195
196     my $error = send_email(
197       'from'    => $conf->config('invoice_from'), #??? well as good as any
198       'to'      => \@invoicing_list,
199       'subject' => 'Payment receipt',
200       'body'    => [ $receipt_template->fill_in( HASH => {
201                        'date'    => time2str("%a %B %o, %Y", $self->_date),
202                        'name'    => $cust_main->name,
203                        'paynum'  => $self->paynum,
204                        'paid'    => sprintf("%.2f", $self->paid),
205                        'payby'   => ucfirst(lc($payby)),
206                        'payinfo' => $payinfo,
207                        'balance' => $cust_main->balance,
208                    } ) ],
209     );
210     if ( $error ) {
211       warn "can't send payment receipt: $error";
212     }
213
214   }
215
216   '';
217
218 }
219
220 =item void [ REASON ]
221
222 Voids this payment: deletes the payment and all associated applications and
223 adds a record of the voided payment to the FS::cust_pay_void table.
224
225 =cut
226
227 sub void {
228   my $self = shift;
229
230   local $SIG{HUP} = 'IGNORE';
231   local $SIG{INT} = 'IGNORE';
232   local $SIG{QUIT} = 'IGNORE';
233   local $SIG{TERM} = 'IGNORE';
234   local $SIG{TSTP} = 'IGNORE';
235   local $SIG{PIPE} = 'IGNORE';
236
237   my $oldAutoCommit = $FS::UID::AutoCommit;
238   local $FS::UID::AutoCommit = 0;
239   my $dbh = dbh;
240
241   my $cust_pay_void = new FS::cust_pay_void ( {
242     map { $_ => $self->get($_) } $self->fields
243   } );
244   $cust_pay_void->reason(shift) if scalar(@_);
245   my $error = $cust_pay_void->insert;
246   if ( $error ) {
247     $dbh->rollback if $oldAutoCommit;
248     return $error;
249   }
250
251   $error = $self->delete;
252   if ( $error ) {
253     $dbh->rollback if $oldAutoCommit;
254     return $error;
255   }
256
257   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
258
259   '';
260
261 }
262
263 =item delete
264
265 Deletes this payment and all associated applications (see L<FS::cust_bill_pay>),
266 unless the closed flag is set.  In most cases, you want to use the void
267 method instead to leave a record of the deleted payment.
268
269 =cut
270
271 sub delete {
272   my $self = shift;
273   return "Can't delete closed payment" if $self->closed =~ /^Y/i;
274
275   local $SIG{HUP} = 'IGNORE';
276   local $SIG{INT} = 'IGNORE';
277   local $SIG{QUIT} = 'IGNORE';
278   local $SIG{TERM} = 'IGNORE';
279   local $SIG{TSTP} = 'IGNORE';
280   local $SIG{PIPE} = 'IGNORE';
281
282   my $oldAutoCommit = $FS::UID::AutoCommit;
283   local $FS::UID::AutoCommit = 0;
284   my $dbh = dbh;
285
286   foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
287     my $error = $app->delete;
288     if ( $error ) {
289       $dbh->rollback if $oldAutoCommit;
290       return $error;
291     }
292   }
293
294   my $error = $self->SUPER::delete(@_);
295   if ( $error ) {
296     $dbh->rollback if $oldAutoCommit;
297     return $error;
298   }
299
300   if ( $conf->config('deletepayments') ne '' ) {
301
302     my $cust_main = $self->cust_main;
303
304     my $error = send_email(
305       'from'    => $conf->config('invoice_from'), #??? well as good as any
306       'to'      => $conf->config('deletepayments'),
307       'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
308       'body'    => [
309         "This is an automatic message from your Freeside installation\n",
310         "informing you that the following payment has been deleted:\n",
311         "\n",
312         'paynum: '. $self->paynum. "\n",
313         'custnum: '. $self->custnum.
314           " (". $cust_main->last. ", ". $cust_main->first. ")\n",
315         'paid: $'. sprintf("%.2f", $self->paid). "\n",
316         'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
317         'payby: '. $self->payby. "\n",
318         'payinfo: '. $self->payinfo. "\n",
319         'paybatch: '. $self->paybatch. "\n",
320       ],
321     );
322
323     if ( $error ) {
324       $dbh->rollback if $oldAutoCommit;
325       return "can't send payment deletion notification: $error";
326     }
327
328   }
329
330   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
331
332   '';
333
334 }
335
336 =item replace OLD_RECORD
337
338 You probably shouldn't modify payments...
339
340 =item check
341
342 Checks all fields to make sure this is a valid payment.  If there is an error,
343 returns the error, otherwise returns false.  Called by the insert method.
344
345 =cut
346
347 sub check {
348   my $self = shift;
349
350   my $error =
351     $self->ut_numbern('paynum')
352     || $self->ut_numbern('custnum')
353     || $self->ut_money('paid')
354     || $self->ut_numbern('_date')
355     || $self->ut_textn('paybatch')
356     || $self->ut_enum('closed', [ '', 'Y' ])
357   ;
358   return $error if $error;
359
360   return "paid must be > 0 " if $self->paid <= 0;
361
362   return "unknown cust_main.custnum: ". $self->custnum
363     unless $self->invnum
364            || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
365
366   $self->_date(time) unless $self->_date;
367
368   $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREP)$/ or return "Illegal payby";
369   $self->payby($1);
370
371   #false laziness with cust_refund::check
372   if ( $self->payby eq 'CARD' ) {
373     my $payinfo = $self->payinfo;
374     $payinfo =~ s/\D//g;
375     $self->payinfo($payinfo);
376     if ( $self->payinfo ) {
377       $self->payinfo =~ /^(\d{13,16})$/
378         or return "Illegal (mistyped?) credit card number (payinfo)";
379       $self->payinfo($1);
380       validate($self->payinfo) or return "Illegal credit card number";
381       return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
382     } else {
383       $self->payinfo('N/A');
384     }
385
386   } else {
387     $error = $self->ut_textn('payinfo');
388     return $error if $error;
389   }
390
391   $self->SUPER::check;
392 }
393
394 =item cust_bill_pay
395
396 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
397 payment.
398
399 =cut
400
401 sub cust_bill_pay {
402   my $self = shift;
403   sort {    $a->_date  <=> $b->_date
404          || $a->invnum <=> $b->invnum }
405     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
406   ;
407 }
408
409 =item cust_pay_refund
410
411 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
412 payment.
413
414 =cut
415
416 sub cust_pay_refund {
417   my $self = shift;
418   sort { $a->_date <=> $b->_date }
419     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
420   ;
421 }
422
423
424 =item unapplied
425
426 Returns the amount of this payment that is still unapplied; which is
427 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
428 applications (see L<FS::cust_pay_refund>).
429
430 =cut
431
432 sub unapplied {
433   my $self = shift;
434   my $amount = $self->paid;
435   $amount -= $_->amount foreach ( $self->cust_bill_pay );
436   $amount -= $_->amount foreach ( $self->cust_pay_refund );
437   sprintf("%.2f", $amount );
438 }
439
440 =item unrefunded
441
442 Returns the amount of this payment that has not been refuned; which is
443 paid minus all  refund applications (see L<FS::cust_pay_refund>).
444
445 =cut
446
447 sub unrefunded {
448   my $self = shift;
449   my $amount = $self->paid;
450   $amount -= $_->amount foreach ( $self->cust_pay_refund );
451   sprintf("%.2f", $amount );
452 }
453
454
455 =item cust_main
456
457 Returns the parent customer object (see L<FS::cust_main>).
458
459 =cut
460
461 sub cust_main {
462   my $self = shift;
463   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
464 }
465
466 =item payinfo_masked
467
468 Returns a "masked" payinfo field with all but the last four characters replaced
469 by 'x'es.  Useful for displaying credit cards.
470
471 =cut
472
473 sub payinfo_masked {
474   my $self = shift;
475   #some false laziness w/cust_main::paymask
476   if ( $self->payby eq 'CARD' ) {
477     my $payinfo = $self->payinfo;
478     'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
479   } elsif ( $self->payby eq 'CHEK' ) {
480     my( $account, $aba ) = split('@', $self->payinfo );
481     'x'x(length($account)-2). substr($account,(length($account)-2)). "@". $aba;
482   } else {
483     $self->payinfo;
484   }
485 }
486
487 =back
488
489 =head1 BUGS
490
491 Delete and replace methods.  payinfo_masked false laziness with cust_main.pm
492 and cust_refund.pm
493
494 =head1 SEE ALSO
495
496 L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>, schema.html from the
497 base documentation.
498
499 =cut
500
501 1;
502