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