d36bae6c241597faf541588d6d1b523942780d43
[freeside.git] / FS / FS / cust_pay.pm
1 package FS::cust_pay;
2
3 use strict;
4 use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
5              FS::Record );
6 use vars qw( $DEBUG $me $conf @encrypted_fields
7              $unsuspendauto $ignore_noapply 
8            );
9 use Date::Format;
10 use Business::CreditCard;
11 use Text::Template;
12 use FS::UID qw( getotaker );
13 use FS::Misc qw( send_email );
14 use FS::Misc::DateTime qw( parse_datetime ); #for batch_import
15 use FS::Record qw( dbh qsearch qsearchs );
16 use FS::CurrentUser;
17 use FS::payby;
18 use FS::cust_main_Mixin;
19 use FS::payinfo_transaction_Mixin;
20 use FS::cust_bill;
21 use FS::cust_bill_pay;
22 use FS::cust_pay_refund;
23 use FS::cust_main;
24 use FS::cust_pkg;
25 use FS::cust_pay_void;
26 use FS::upgrade_journal;
27 use FS::Cursor;
28
29 $DEBUG = 0;
30
31 $me = '[FS::cust_pay]';
32
33 $ignore_noapply = 0;
34
35 #ask FS::UID to run this stuff for us later
36 FS::UID->install_callback( sub { 
37   $conf = new FS::Conf;
38   $unsuspendauto = $conf->exists('unsuspendauto');
39 } );
40
41 @encrypted_fields = ('payinfo');
42 sub nohistory_fields { ('payinfo'); }
43
44 =head1 NAME
45
46 FS::cust_pay - Object methods for cust_pay objects
47
48 =head1 SYNOPSIS
49
50   use FS::cust_pay;
51
52   $record = new FS::cust_pay \%hash;
53   $record = new FS::cust_pay { 'column' => 'value' };
54
55   $error = $record->insert;
56
57   $error = $new_record->replace($old_record);
58
59   $error = $record->delete;
60
61   $error = $record->check;
62
63 =head1 DESCRIPTION
64
65 An FS::cust_pay object represents a payment; the transfer of money from a
66 customer.  FS::cust_pay inherits from FS::Record.  The following fields are
67 currently supported:
68
69 =over 4
70
71 =item paynum
72
73 primary key (assigned automatically for new payments)
74
75 =item custnum
76
77 customer (see L<FS::cust_main>)
78
79 =item _date
80
81 specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
82 L<Time::Local> and L<Date::Parse> for conversion functions.
83
84 =item paid
85
86 Amount of this payment
87
88 =item usernum
89
90 order taker (see L<FS::access_user>)
91
92 =item payby
93
94 Payment Type (See L<FS::payinfo_Mixin> for valid values)
95
96 =item payinfo
97
98 Payment Information (See L<FS::payinfo_Mixin> for data format)
99
100 =item paymask
101
102 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
103
104 =item paybatch
105
106 obsolete text field for tracking card processing or other batch grouping
107
108 =item payunique
109
110 Optional unique identifer to prevent duplicate transactions.
111
112 =item closed
113
114 books closed flag, empty or `Y'
115
116 =item pkgnum
117
118 Desired pkgnum when using experimental package balances.
119
120 =item bank
121
122 The bank where the payment was deposited.
123
124 =item depositor
125
126 The name of the depositor.
127
128 =item account
129
130 The deposit account number.
131
132 =item teller
133
134 The teller number.
135
136 =item batchnum
137
138 The number of the batch this payment came from (see L<FS::pay_batch>), 
139 or null if it was processed through a realtime gateway or entered manually.
140
141 =item gatewaynum
142
143 The number of the realtime or batch gateway L<FS::payment_gateway>) this 
144 payment was processed through.  Null if it was entered manually or processed
145 by the "system default" gateway, which doesn't have a number.
146
147 =item processor
148
149 The name of the processor module (Business::OnlinePayment, ::BatchPayment, 
150 or ::OnlineThirdPartyPayment subclass) used for this payment.  Slightly
151 redundant with C<gatewaynum>.
152
153 =item auth
154
155 The authorization number returned by the credit card network.
156
157 =item order_number
158
159 The transaction ID returned by the gateway, if any.  This is usually what 
160 you would use to initiate a void or refund of the payment.
161
162 =back
163
164 =head1 METHODS
165
166 =over 4 
167
168 =item new HASHREF
169
170 Creates a new payment.  To add the payment to the databse, see L<"insert">.
171
172 =cut
173
174 sub table { 'cust_pay'; }
175 sub cust_linked { $_[0]->cust_main_custnum; } 
176 sub cust_unlinked_msg {
177   my $self = shift;
178   "WARNING: can't find cust_main.custnum ". $self->custnum.
179   ' (cust_pay.paynum '. $self->paynum. ')';
180 }
181
182 =item insert [ OPTION => VALUE ... ]
183
184 Adds this payment to the database.
185
186 For backwards-compatibility and convenience, if the additional field invnum
187 is defined, an FS::cust_bill_pay record for the full amount of the payment
188 will be created.  In this case, custnum is optional.
189
190 If the additional field discount_term is defined then a prepayment discount
191 is taken for that length of time.  It is an error for the customer to owe
192 after this payment is made.
193
194 A hash of optional arguments may be passed.  Currently "manual" is supported.
195 If true, a payment receipt is sent instead of a statement when
196 'payment_receipt_email' configuration option is set.
197
198 About the "manual" flag: Normally, if the 'payment_receipt' config option 
199 is set, and the customer has an invoice email address, inserting a payment
200 causes a I<statement> to be emailed to the customer.  If the payment is 
201 considered "manual" (or if the customer has no invoices), then it will 
202 instead send a I<payment receipt>.  "manual" should be true whenever a 
203 payment is created directly from the web interface, from a user-initiated
204 realtime payment, or from a third-party payment via self-service.  It should
205 be I<false> when creating a payment from a billing event or from a batch.
206
207 =cut
208
209 sub insert {
210   my($self, %options) = @_;
211
212   local $SIG{HUP} = 'IGNORE';
213   local $SIG{INT} = 'IGNORE';
214   local $SIG{QUIT} = 'IGNORE';
215   local $SIG{TERM} = 'IGNORE';
216   local $SIG{TSTP} = 'IGNORE';
217   local $SIG{PIPE} = 'IGNORE';
218
219   my $oldAutoCommit = $FS::UID::AutoCommit;
220   local $FS::UID::AutoCommit = 0;
221   my $dbh = dbh;
222
223   my $cust_bill;
224   if ( $self->invnum ) {
225     $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
226       or do {
227         $dbh->rollback if $oldAutoCommit;
228         return "Unknown cust_bill.invnum: ". $self->invnum;
229       };
230     $self->custnum($cust_bill->custnum );
231   }
232
233   my $error = $self->check;
234   return $error if $error;
235
236   my $cust_main = $self->cust_main;
237   my $old_balance = $cust_main->balance;
238
239   $error = $self->SUPER::insert;
240   if ( $error ) {
241     $dbh->rollback if $oldAutoCommit;
242     return "error inserting cust_pay: $error";
243   }
244
245   if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
246     if ( my $months = $self->discount_term ) {
247       # XXX this should be moved out somewhere, but discount_term_values
248       # doesn't fit right
249       my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
250       return "can't accept prepayment for an unbilled customer" if !$cust_bill;
251
252       # %billing_pkgs contains this customer's active monthly packages. 
253       # Recurring fees for those packages will be credited and then rebilled 
254       # for the full discount term.  Other packages on the last invoice 
255       # (canceled, non-monthly recurring, or one-time charges) will be 
256       # left as they are.
257       my %billing_pkgs = map { $_->pkgnum => $_ } 
258                          grep { $_->part_pkg->freq eq '1' } 
259                          $cust_main->billing_pkgs;
260       my $credit = 0; # sum of recurring charges from that invoice
261       my $last_bill_date = 0; # the real bill date
262       foreach my $item ( $cust_bill->cust_bill_pkg ) {
263         next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
264         $credit += $item->recur;
265         $last_bill_date = $item->cust_pkg->last_bill 
266           if defined($item->cust_pkg) 
267             and $item->cust_pkg->last_bill > $last_bill_date
268       }
269
270       my $cust_credit = new FS::cust_credit {
271         'custnum' => $self->custnum,
272         'amount'  => sprintf('%.2f', $credit),
273         'reason'  => 'customer chose to prepay for discount',
274       };
275       $error = $cust_credit->insert('reason_type' => $credit_type);
276       if ( $error ) {
277         $dbh->rollback if $oldAutoCommit;
278         return "error inserting prepayment credit: $error";
279       }
280       # don't apply it yet
281
282       # bill for the entire term
283       $_->bill($_->last_bill) foreach (values %billing_pkgs);
284       $error = $cust_main->bill(
285         # no recurring_only, we want unbilled packages with start dates to 
286         # get billed
287         'no_usage_reset' => 1,
288         'time'           => $last_bill_date, # not $cust_bill->_date
289         'pkg_list'       => [ values %billing_pkgs ],
290         'freq_override'  => $months,
291       );
292       if ( $error ) {
293         $dbh->rollback if $oldAutoCommit;
294         return "error inserting cust_pay: $error";
295       }
296       $error = $cust_main->apply_payments_and_credits;
297       if ( $error ) {
298         $dbh->rollback if $oldAutoCommit;
299         return "error inserting cust_pay: $error";
300       }
301       my $new_balance = $cust_main->balance;
302       if ($new_balance > 0) {
303         $dbh->rollback if $oldAutoCommit;
304         return "balance after prepay discount attempt: $new_balance";
305       }
306       # user friendly: override the "apply only to this invoice" mode
307       $self->invnum('');
308       
309     }
310
311   }
312
313   if ( $self->invnum ) {
314     my $cust_bill_pay = new FS::cust_bill_pay {
315       'invnum' => $self->invnum,
316       'paynum' => $self->paynum,
317       'amount' => $self->paid,
318       '_date'  => $self->_date,
319     };
320     $error = $cust_bill_pay->insert(%options);
321     if ( $error ) {
322       if ( $ignore_noapply ) {
323         warn "warning: error inserting cust_bill_pay: $error ".
324              "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
325       } else {
326         $dbh->rollback if $oldAutoCommit;
327         return "error inserting cust_bill_pay: $error";
328       }
329     }
330   }
331
332   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
333
334   #false laziness w/ cust_credit::insert
335   if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
336     my @errors = $cust_main->unsuspend;
337     #return 
338     # side-fx with nested transactions?  upstack rolls back?
339     warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
340          join(' / ', @errors)
341       if @errors;
342   }
343   #eslaf
344
345   #bill setup fees for voip_cdr bill_every_call packages
346   #some false laziness w/search in freeside-cdrd
347   my $addl_from =
348     'LEFT JOIN part_pkg USING ( pkgpart ) '.
349     "LEFT JOIN part_pkg_option
350        ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
351             AND part_pkg_option.optionname = 'bill_every_call' )";
352
353   my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
354                   " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
355
356   my @cust_pkg = qsearch({
357     'table'     => 'cust_pkg',
358     'addl_from' => $addl_from,
359     'hashref'   => { 'custnum' => $self->custnum,
360                      'susp'    => '',
361                      'cancel'  => '',
362                    },
363     'extra_sql' => $extra_sql,
364   });
365
366   if ( @cust_pkg ) {
367     warn "voip_cdr bill_every_call packages found; billing customer\n";
368     my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
369     if ( $bill_error ) {
370       warn "WARNING: Error billing customer: $bill_error\n";
371     }
372   }
373   #end of billing setup fees for voip_cdr bill_every_call packages
374
375   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
376
377   #payment receipt
378   my $trigger = $conf->config('payment_receipt-trigger', 
379                               $self->cust_main->agentnum) || 'cust_pay';
380   if ( $trigger eq 'cust_pay' ) {
381     my $error = $self->send_receipt(
382       'manual'    => $options{'manual'},
383       'cust_bill' => $cust_bill,
384       'cust_main' => $cust_main,
385     );
386     warn "can't send payment receipt/statement: $error" if $error;
387   }
388
389   '';
390
391 }
392
393 =item void [ REASON ]
394
395 Voids this payment: deletes the payment and all associated applications and
396 adds a record of the voided payment to the FS::cust_pay_void table.
397
398 =cut
399
400 sub void {
401   my $self = shift;
402
403   local $SIG{HUP} = 'IGNORE';
404   local $SIG{INT} = 'IGNORE';
405   local $SIG{QUIT} = 'IGNORE';
406   local $SIG{TERM} = 'IGNORE';
407   local $SIG{TSTP} = 'IGNORE';
408   local $SIG{PIPE} = 'IGNORE';
409
410   my $oldAutoCommit = $FS::UID::AutoCommit;
411   local $FS::UID::AutoCommit = 0;
412   my $dbh = dbh;
413
414   my $cust_pay_void = new FS::cust_pay_void ( {
415     map { $_ => $self->get($_) } $self->fields
416   } );
417   $cust_pay_void->reason(shift) if scalar(@_);
418   my $error = $cust_pay_void->insert;
419   if ( $error ) {
420     $dbh->rollback if $oldAutoCommit;
421     return $error;
422   }
423
424   $error = $self->delete;
425   if ( $error ) {
426     $dbh->rollback if $oldAutoCommit;
427     return $error;
428   }
429
430   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
431
432   '';
433
434 }
435
436 =item delete
437
438 Unless the closed flag is set, deletes this payment and all associated
439 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>).  In most
440 cases, you want to use the void method instead to leave a record of the
441 deleted payment.
442
443 =cut
444
445 # very similar to FS::cust_credit::delete
446 sub delete {
447   my $self = shift;
448   return "Can't delete closed payment" if $self->closed =~ /^Y/i;
449
450   local $SIG{HUP} = 'IGNORE';
451   local $SIG{INT} = 'IGNORE';
452   local $SIG{QUIT} = 'IGNORE';
453   local $SIG{TERM} = 'IGNORE';
454   local $SIG{TSTP} = 'IGNORE';
455   local $SIG{PIPE} = 'IGNORE';
456
457   my $oldAutoCommit = $FS::UID::AutoCommit;
458   local $FS::UID::AutoCommit = 0;
459   my $dbh = dbh;
460
461   foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
462     my $error = $app->delete;
463     if ( $error ) {
464       $dbh->rollback if $oldAutoCommit;
465       return $error;
466     }
467   }
468
469   my $error = $self->SUPER::delete(@_);
470   if ( $error ) {
471     $dbh->rollback if $oldAutoCommit;
472     return $error;
473   }
474
475   if (    $conf->exists('deletepayments')
476        && $conf->config('deletepayments') ne '' ) {
477
478     my $cust_main = $self->cust_main;
479
480     my $error = send_email(
481       'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
482                                  #invoice_from??? well as good as any
483       'to'      => $conf->config('deletepayments'),
484       'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
485       'body'    => [
486         "This is an automatic message from your Freeside installation\n",
487         "informing you that the following payment has been deleted:\n",
488         "\n",
489         'paynum: '. $self->paynum. "\n",
490         'custnum: '. $self->custnum.
491           " (". $cust_main->last. ", ". $cust_main->first. ")\n",
492         'paid: $'. sprintf("%.2f", $self->paid). "\n",
493         'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
494         'payby: '. $self->payby. "\n",
495         'payinfo: '. $self->paymask. "\n",
496         'paybatch: '. $self->paybatch. "\n",
497       ],
498     );
499
500     if ( $error ) {
501       $dbh->rollback if $oldAutoCommit;
502       return "can't send payment deletion notification: $error";
503     }
504
505   }
506
507   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
508
509   '';
510
511 }
512
513 =item replace [ OLD_RECORD ]
514
515 You can, but probably shouldn't modify payments...
516
517 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
518 supplied, replaces this record.  If there is an error, returns the error,
519 otherwise returns false.
520
521 =cut
522
523 sub replace {
524   my $self = shift;
525   return "Can't modify closed payment" if $self->closed =~ /^Y/i;
526   $self->SUPER::replace(@_);
527 }
528
529 =item check
530
531 Checks all fields to make sure this is a valid payment.  If there is an error,
532 returns the error, otherwise returns false.  Called by the insert method.
533
534 =cut
535
536 sub check {
537   my $self = shift;
538
539   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
540
541   my $error =
542     $self->ut_numbern('paynum')
543     || $self->ut_numbern('custnum')
544     || $self->ut_numbern('_date')
545     || $self->ut_money('paid')
546     || $self->ut_alphan('otaker')
547     || $self->ut_textn('paybatch')
548     || $self->ut_textn('payunique')
549     || $self->ut_enum('closed', [ '', 'Y' ])
550     || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
551     || $self->ut_textn('bank')
552     || $self->ut_alphan('depositor')
553     || $self->ut_numbern('account')
554     || $self->ut_numbern('teller')
555     || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
556     || $self->payinfo_check()
557   ;
558   return $error if $error;
559
560   return "paid must be > 0 " if $self->paid <= 0;
561
562   return "unknown cust_main.custnum: ". $self->custnum
563     unless $self->invnum
564            || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
565
566   $self->_date(time) unless $self->_date;
567
568   return "invalid discount_term"
569    if ($self->discount_term && $self->discount_term < 2);
570
571   if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
572     foreach (qw(bank depositor account teller)) {
573       return "$_ required" if $self->get($_) eq '';
574     }
575   }
576
577 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
578 #  # UNIQUE index should catch this too, without race conditions, but this
579 #  # should give a better error message the other 99.9% of the time...
580 #  if ( length($self->payunique)
581 #       && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
582 #    #well, it *could* be a better error message
583 #    return "duplicate transaction".
584 #           " - a payment with unique identifer ". $self->payunique.
585 #           " already exists";
586 #  }
587
588   $self->SUPER::check;
589 }
590
591 =item send_receipt HASHREF | OPTION => VALUE ...
592
593 Sends a payment receipt for this payment..
594
595 Available options:
596
597 =over 4
598
599 =item manual
600
601 Flag indicating the payment is being made manually.
602
603 =item cust_bill
604
605 Invoice (FS::cust_bill) object.  If not specified, the most recent invoice
606 will be assumed.
607
608 =item cust_main
609
610 Customer (FS::cust_main) object (for efficiency).
611
612 =back
613
614 =cut
615
616 sub send_receipt {
617   my $self = shift;
618   my $opt = ref($_[0]) ? shift : { @_ };
619
620   my $cust_bill = $opt->{'cust_bill'};
621   my $cust_main = $opt->{'cust_main'} || $self->cust_main;
622
623   my $conf = new FS::Conf;
624
625   return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
626
627   my @invoicing_list = $cust_main->invoicing_list_emailonly;
628   return '' unless @invoicing_list;
629
630   $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
631
632   my $error = '';
633
634   if (    ( exists($opt->{'manual'}) && $opt->{'manual'} )
635        #|| ! $conf->exists('invoice_html_statement')
636        || ! $cust_bill
637      )
638   {
639     my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
640     if ( $msgnum ) {
641
642       my $queue = new FS::queue {
643         'job'     => 'FS::Misc::process_send_email',
644         'paynum'  => $self->paynum,
645         'custnum' => $cust_main->custnum,
646       };
647       $error = $queue->insert(
648         FS::msg_template->by_key($msgnum)->prepare(
649           'cust_main'   => $cust_main,
650           'object'      => $self,
651           'from_config' => 'payment_receipt_from',
652         ),
653         'msgtype' => 'receipt', # override msg_template's default
654       );
655
656     } elsif ( $conf->exists('payment_receipt_email') ) {
657
658       my $receipt_template = new Text::Template (
659         TYPE   => 'ARRAY',
660         SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
661       ) or do {
662         warn "can't create payment receipt template: $Text::Template::ERROR";
663         return '';
664       };
665
666       my $payby = $self->payby;
667       my $payinfo = $self->payinfo;
668       $payby =~ s/^BILL$/Check/ if $payinfo;
669       if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
670         $payinfo = $self->paymask
671       } else {
672         $payinfo = $self->decrypt($payinfo);
673       }
674       $payby =~ s/^CHEK$/Electronic check/;
675
676       my %fill_in = (
677         'date'         => time2str("%a %B %o, %Y", $self->_date),
678         'name'         => $cust_main->name,
679         'paynum'       => $self->paynum,
680         'paid'         => sprintf("%.2f", $self->paid),
681         'payby'        => ucfirst(lc($payby)),
682         'payinfo'      => $payinfo,
683         'balance'      => $cust_main->balance,
684         'company_name' => $conf->config('company_name', $cust_main->agentnum),
685       );
686
687       $fill_in{'invnum'} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
688
689       if ( $opt->{'cust_pkg'} ) {
690         $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
691         #setup date, other things?
692       }
693
694       my $queue = new FS::queue {
695         'job'     => 'FS::Misc::process_send_generated_email',
696         'paynum'  => $self->paynum,
697         'custnum' => $cust_main->custnum,
698         'msgtype' => 'receipt',
699       };
700       $error = $queue->insert(
701         'from'    => $conf->config('invoice_from', $cust_main->agentnum),
702                                    #invoice_from??? well as good as any
703         'to'      => \@invoicing_list,
704         'subject' => 'Payment receipt',
705         'body'    => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
706       );
707
708     } else {
709
710       warn "payment_receipt is on, but no payment_receipt_msgnum\n";
711
712     }
713
714   } elsif ( ! $cust_main->invoice_noemail ) { #not manual
715
716     my $queue = new FS::queue {
717        'job'     => 'FS::cust_bill::queueable_email',
718        'paynum'  => $self->paynum,
719        'custnum' => $cust_main->custnum,
720     };
721
722     $error = $queue->insert(
723       'invnum'      => $cust_bill->invnum,
724       'template'    => 'statement',
725       'notice_name' => 'Statement',
726       'no_coupon'   => 1,
727     );
728
729   }
730   
731   warn "send_receipt: $error\n" if $error;
732 }
733
734 =item cust_bill_pay
735
736 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
737 payment.
738
739 =cut
740
741 sub cust_bill_pay {
742   my $self = shift;
743   map { $_ } #return $self->num_cust_bill_pay unless wantarray;
744   sort {    $a->_date  <=> $b->_date
745          || $a->invnum <=> $b->invnum }
746     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
747   ;
748 }
749
750 =item cust_pay_refund
751
752 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
753 payment.
754
755 =cut
756
757 sub cust_pay_refund {
758   my $self = shift;
759   map { $_ } #return $self->num_cust_pay_refund unless wantarray;
760   sort { $a->_date <=> $b->_date }
761     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
762   ;
763 }
764
765
766 =item unapplied
767
768 Returns the amount of this payment that is still unapplied; which is
769 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
770 applications (see L<FS::cust_pay_refund>).
771
772 =cut
773
774 sub unapplied {
775   my $self = shift;
776   my $amount = $self->paid;
777   $amount -= $_->amount foreach ( $self->cust_bill_pay );
778   $amount -= $_->amount foreach ( $self->cust_pay_refund );
779   sprintf("%.2f", $amount );
780 }
781
782 =item unrefunded
783
784 Returns the amount of this payment that has not been refuned; which is
785 paid minus all  refund applications (see L<FS::cust_pay_refund>).
786
787 =cut
788
789 sub unrefunded {
790   my $self = shift;
791   my $amount = $self->paid;
792   $amount -= $_->amount foreach ( $self->cust_pay_refund );
793   sprintf("%.2f", $amount );
794 }
795
796 =item amount
797
798 Returns the "paid" field.
799
800 =cut
801
802 sub amount {
803   my $self = shift;
804   $self->paid();
805 }
806
807 =back
808
809 =head1 CLASS METHODS
810
811 =over 4
812
813 =item batch_insert CUST_PAY_OBJECT, ...
814
815 Class method which inserts multiple payments.  Takes a list of FS::cust_pay
816 objects.  Returns a list, each element representing the status of inserting the
817 corresponding payment - empty.  If there is an error inserting any payment, the
818 entire transaction is rolled back, i.e. all payments are inserted or none are.
819
820 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a 
821 reference to an array of (uninserted) FS::cust_bill_pay objects.  If so,
822 those objects will be inserted with the paynum of the payment, and for 
823 each one, an error message or an empty string will be inserted into the 
824 list of errors.
825
826 For example:
827
828   my @errors = FS::cust_pay->batch_insert(@cust_pay);
829   my $num_errors = scalar(grep $_, @errors);
830   if ( $num_errors == 0 ) {
831     #success; all payments were inserted
832   } else {
833     #failure; no payments were inserted.
834   }
835
836 =cut
837
838 sub batch_insert {
839   my $self = shift; #class method
840
841   local $SIG{HUP} = 'IGNORE';
842   local $SIG{INT} = 'IGNORE';
843   local $SIG{QUIT} = 'IGNORE';
844   local $SIG{TERM} = 'IGNORE';
845   local $SIG{TSTP} = 'IGNORE';
846   local $SIG{PIPE} = 'IGNORE';
847
848   my $oldAutoCommit = $FS::UID::AutoCommit;
849   local $FS::UID::AutoCommit = 0;
850   my $dbh = dbh;
851
852   my $num_errors = 0;
853   
854   my @errors;
855   foreach my $cust_pay (@_) {
856     my $error = $cust_pay->insert( 'manual' => 1 );
857     push @errors, $error;
858     $num_errors++ if $error;
859
860     if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
861
862       foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
863         if ( $error ) { # insert placeholders if cust_pay wasn't inserted
864           push @errors, '';
865         }
866         else {
867           $cust_bill_pay->set('paynum', $cust_pay->paynum);
868           my $apply_error = $cust_bill_pay->insert;
869           push @errors, $apply_error || '';
870           $num_errors++ if $apply_error;
871         }
872       }
873
874     } elsif ( !$error ) { #normal case: apply payments as usual
875       $cust_pay->cust_main->apply_payments;
876     }
877
878   }
879
880   if ( $num_errors ) {
881     $dbh->rollback if $oldAutoCommit;
882   } else {
883     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
884   }
885
886   @errors;
887
888 }
889
890 =item unapplied_sql
891
892 Returns an SQL fragment to retreive the unapplied amount.
893
894 =cut 
895
896 sub unapplied_sql {
897   my ($class, $start, $end) = @_;
898   my $bill_start   = $start ? "AND cust_bill_pay._date <= $start"   : '';
899   my $bill_end     = $end   ? "AND cust_bill_pay._date > $end"     : '';
900   my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
901   my $refund_end   = $end   ? "AND cust_pay_refund._date > $end"   : '';
902
903   "paid
904         - COALESCE( 
905                     ( SELECT SUM(amount) FROM cust_bill_pay
906                         WHERE cust_pay.paynum = cust_bill_pay.paynum
907                         $bill_start $bill_end )
908                     ,0
909                   )
910         - COALESCE(
911                     ( SELECT SUM(amount) FROM cust_pay_refund
912                         WHERE cust_pay.paynum = cust_pay_refund.paynum
913                         $refund_start $refund_end )
914                     ,0
915                   )
916   ";
917
918 }
919
920 # _upgrade_data
921 #
922 # Used by FS::Upgrade to migrate to a new database.
923
924 use FS::h_cust_pay;
925
926 sub _upgrade_data {  #class method
927   my ($class, %opts) = @_;
928
929   warn "$me upgrading $class\n" if $DEBUG;
930
931   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
932
933   ##
934   # otaker/ivan upgrade
935   ##
936
937   unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
938
939     #not the most efficient, but hey, it only has to run once
940
941     my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
942                 "  AND usernum IS NULL ".
943                 "  AND 0 < ( SELECT COUNT(*) FROM cust_main                 ".
944                 "              WHERE cust_main.custnum = cust_pay.custnum ) ";
945
946     my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
947
948     my $sth = dbh->prepare($count_sql) or die dbh->errstr;
949     $sth->execute or die $sth->errstr;
950     my $total = $sth->fetchrow_arrayref->[0];
951     #warn "$total cust_pay records to update\n"
952     #  if $DEBUG;
953     local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
954
955     my $count = 0;
956     my $lastprog = 0;
957
958     my @cust_pay = qsearch( {
959         'table'     => 'cust_pay',
960         'hashref'   => {},
961         'extra_sql' => $where,
962         'order_by'  => 'ORDER BY paynum',
963     } );
964
965     foreach my $cust_pay (@cust_pay) {
966
967       my $h_cust_pay = $cust_pay->h_search('insert');
968       if ( $h_cust_pay ) {
969         next if $cust_pay->otaker eq $h_cust_pay->history_user;
970         #$cust_pay->otaker($h_cust_pay->history_user);
971         $cust_pay->set('otaker', $h_cust_pay->history_user);
972       } else {
973         $cust_pay->set('otaker', 'legacy');
974       }
975
976       delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
977       my $error = $cust_pay->replace;
978
979       if ( $error ) {
980         warn " *** WARNING: Error updating order taker for payment paynum ".
981              $cust_pay->paynun. ": $error\n";
982         next;
983       }
984
985       $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
986
987       $count++;
988       if ( $DEBUG > 1 && $lastprog + 30 < time ) {
989         warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
990         $lastprog = time;
991       }
992
993     }
994
995     FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
996   }
997
998   ###
999   # payinfo N/A upgrade
1000   ###
1001
1002   unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1003
1004     #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1005
1006     my @na_cust_pay = qsearch( {
1007       'table'     => 'cust_pay',
1008       'hashref'   => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1009       'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1010     } );
1011
1012     foreach my $na ( @na_cust_pay ) {
1013
1014       next unless $na->payinfo eq 'N/A';
1015
1016       my $cust_pay_pending =
1017         qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1018       unless ( $cust_pay_pending ) {
1019         warn " *** WARNING: not-yet recoverable N/A card for payment ".
1020              $na->paynum. " (no cust_pay_pending)\n";
1021         next;
1022       }
1023       $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1024       my $error = $na->replace;
1025       if ( $error ) {
1026         warn " *** WARNING: Error updating payinfo for payment paynum ".
1027              $na->paynun. ": $error\n";
1028         next;
1029       }
1030
1031     }
1032
1033     FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1034   }
1035
1036   ###
1037   # otaker->usernum upgrade
1038   ###
1039
1040   delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1041   $class->_upgrade_otaker(%opts);
1042   $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1043
1044   ###
1045   # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1046   ###
1047   my $search = FS::Cursor->new( {
1048     'table'     => 'cust_pay',
1049     'addl_from' => ' JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS text) ',
1050   } );
1051   while (my $cust_pay = $search->fetch) {
1052     $cust_pay->set('batchnum' => $cust_pay->paybatch);
1053     $cust_pay->set('paybatch' => '');
1054     my $error = $cust_pay->replace;
1055     warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n  $error"
1056     if $error;
1057   }
1058
1059   ###
1060   # migrate gateway info from the misused 'paybatch' field
1061   ###
1062
1063   # not only cust_pay, but also voided and refunded payments
1064   if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1065     local $FS::Record::nowarn_classload=1;
1066     # really inefficient, but again, only has to run once
1067     foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1068       my $and_batchnum_is_null =
1069         ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1070       my $search = FS::Cursor->new({
1071         table     => $table,
1072         extra_sql => "WHERE payby IN('CARD','CHEK') ".
1073                      "AND (paybatch IS NOT NULL ".
1074                      "OR (paybatch IS NULL AND auth IS NULL
1075                      $and_batchnum_is_null ) )",
1076       });
1077       while ( my $object = $search->fetch ) {
1078         if ( $object->paybatch eq '' ) {
1079           # repair for a previous upgrade that didn't save 'auth'
1080           my $pkey = $object->primary_key;
1081           # find the last history record that had a paybatch value
1082           my $h = qsearchs({
1083               table   => "h_$table",
1084               hashref => {
1085                 $pkey     => $object->$pkey,
1086                 paybatch  => { op=>'!=', value=>''},
1087                 history_action => 'replace_old',
1088               },
1089               order_by => 'ORDER BY history_date DESC LIMIT 1',
1090           });
1091           if (!$h) {
1092             warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1093             next;
1094           }
1095           # if the paybatch didn't have an auth string, then it's fine
1096           $h->paybatch =~ /:(\w+):/ or next;
1097           # set paybatch to what it was in that record
1098           $object->set('paybatch', $h->paybatch)
1099           # and then upgrade it like the old records
1100         }
1101
1102         my $parsed = $object->_parse_paybatch;
1103         if (keys %$parsed) {
1104           $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1105           $object->set('auth' => $parsed->{authorization});
1106           $object->set('paybatch', '');
1107           my $error = $object->replace;
1108           warn "error parsing CARD/CHEK paybatch fields on $object #".
1109             $object->get($object->primary_key).":\n  $error\n"
1110             if $error;
1111         }
1112       } #$object
1113     } #$table
1114     FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1115   }
1116 }
1117
1118 =back
1119
1120 =head1 SUBROUTINES
1121
1122 =over 4 
1123
1124 =item batch_import HASHREF
1125
1126 Inserts new payments.
1127
1128 =cut
1129
1130 sub batch_import {
1131   my $param = shift;
1132
1133   my $fh       = $param->{filehandle};
1134   my $format   = $param->{'format'};
1135
1136   my $agentnum = $param->{agentnum};
1137   my $_date    = $param->{_date};
1138   $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1139   my $paybatch = $param->{'paybatch'};
1140
1141   my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1142   my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1143
1144   # here is the agent virtualization
1145   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1146
1147   my @fields;
1148   my $payby;
1149   if ( $format eq 'simple' ) {
1150     @fields = qw( custnum agent_custid paid payinfo );
1151     $payby = 'BILL';
1152   } elsif ( $format eq 'extended' ) {
1153     die "unimplemented\n";
1154     @fields = qw( );
1155     $payby = 'BILL';
1156   } else {
1157     die "unknown format $format";
1158   }
1159
1160   eval "use Text::CSV_XS;";
1161   die $@ if $@;
1162
1163   my $csv = new Text::CSV_XS;
1164
1165   my $imported = 0;
1166
1167   local $SIG{HUP} = 'IGNORE';
1168   local $SIG{INT} = 'IGNORE';
1169   local $SIG{QUIT} = 'IGNORE';
1170   local $SIG{TERM} = 'IGNORE';
1171   local $SIG{TSTP} = 'IGNORE';
1172   local $SIG{PIPE} = 'IGNORE';
1173
1174   my $oldAutoCommit = $FS::UID::AutoCommit;
1175   local $FS::UID::AutoCommit = 0;
1176   my $dbh = dbh;
1177   
1178   my $line;
1179   while ( defined($line=<$fh>) ) {
1180
1181     $csv->parse($line) or do {
1182       $dbh->rollback if $oldAutoCommit;
1183       return "can't parse: ". $csv->error_input();
1184     };
1185
1186     my @columns = $csv->fields();
1187
1188     my %cust_pay = (
1189       payby    => $payby,
1190       paybatch => $paybatch,
1191     );
1192     $cust_pay{_date} = $_date if $_date;
1193
1194     my $cust_main;
1195     foreach my $field ( @fields ) {
1196
1197       if ( $field eq 'agent_custid'
1198         && $agentnum
1199         && $columns[0] =~ /\S+/ )
1200       {
1201
1202         my $agent_custid = $columns[0];
1203         my %hash = ( 'agent_custid' => $agent_custid,
1204                      'agentnum'     => $agentnum,
1205                    );
1206
1207         if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1208           $dbh->rollback if $oldAutoCommit;
1209           return "can't specify custnum with agent_custid $agent_custid";
1210         }
1211
1212         $cust_main = qsearchs({
1213                                 'table'     => 'cust_main',
1214                                 'hashref'   => \%hash,
1215                                 'extra_sql' => $extra_sql,
1216                              });
1217
1218         unless ( $cust_main ) {
1219           $dbh->rollback if $oldAutoCommit;
1220           return "can't find customer with agent_custid $agent_custid";
1221         }
1222
1223         $field = 'custnum';
1224         $columns[0] = $cust_main->custnum;
1225       }
1226
1227       $cust_pay{$field} = shift @columns; 
1228     }
1229
1230     if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1231                          && length($1) == $custnum_length ) {
1232       $cust_pay{custnum} = $2;
1233     }
1234
1235     my $cust_pay = new FS::cust_pay( \%cust_pay );
1236     my $error = $cust_pay->insert;
1237
1238     if ( $error ) {
1239       $dbh->rollback if $oldAutoCommit;
1240       return "can't insert payment for $line: $error";
1241     }
1242
1243     if ( $format eq 'simple' ) {
1244       # include agentnum for less surprise?
1245       $cust_main = qsearchs({
1246                              'table'     => 'cust_main',
1247                              'hashref'   => { 'custnum' => $cust_pay->custnum },
1248                              'extra_sql' => $extra_sql,
1249                            })
1250         unless $cust_main;
1251
1252       unless ( $cust_main ) {
1253         $dbh->rollback if $oldAutoCommit;
1254         return "can't find customer to which payments apply at line: $line";
1255       }
1256
1257       $error = $cust_main->apply_payments_and_credits;
1258       if ( $error ) {
1259         $dbh->rollback if $oldAutoCommit;
1260         return "can't apply payments to customer for $line: $error";
1261       }
1262
1263     }
1264
1265     $imported++;
1266   }
1267
1268   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1269
1270   return "Empty file!" unless $imported;
1271
1272   ''; #no error
1273
1274 }
1275
1276 =back
1277
1278 =head1 BUGS
1279
1280 Delete and replace methods.  
1281
1282 =head1 SEE ALSO
1283
1284 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1285 schema.html from the base documentation.
1286
1287 =cut
1288
1289 1;
1290