RT#30825 Modernize Bulk payment importing [fixed format handling]
[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   my $hashcb = sub {
1174     my %hash = @_;
1175     my $custnum = $hash{'custnum'};
1176     my $agentnum = $hash{'agentnum'};
1177     my $agent_custid = $hash{'agent_custid'};
1178     #standardize date
1179     $hash{'_date'} = parse_datetime($hash{'_date'})
1180       if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1181     #remove custnum_prefix
1182     my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1183     my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1184     if (
1185       $custnum_prefix 
1186       && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1187       && length($1) == $custnum_length 
1188     ) {
1189       $custnum = $2;
1190     }
1191     # check agentnum against custnum and
1192     # translate agent_custid into regular custnum
1193     if ($custnum && $agent_custid) {
1194       die "can't specify both custnum and agent_custid\n";
1195     } elsif ($agentnum || $agent_custid) {
1196       # here is the agent virtualization
1197       my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1198       my %search;
1199       $search{'agentnum'} = $agentnum
1200         if $agentnum;
1201       $search{'agent_custid'} = $agent_custid
1202         if $agent_custid;
1203       $search{'custnum'} = $custnum
1204         if $custnum;
1205       my $cust_main = qsearchs({
1206         'table'     => 'cust_main',
1207         'hashref'   => \%search,
1208         'extra_sql' => $extra_sql,
1209       });
1210       die "can't find customer with" .
1211         ($agentnum ? " agentnum $agentnum" : '') .
1212         ($custnum  ? " custnum $custnum" : '') .
1213         ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1214         unless $cust_main;
1215       die "mismatched customer number\n"
1216         if $custnum && ($custnum ne $cust_main->custnum);
1217       $custnum = $cust_main->custnum;
1218     }
1219     $hash{'custnum'} = $custnum;
1220     delete($hash{'agent_custid'});
1221     return %hash;
1222   };
1223
1224   my $opt = { 'table'   => 'cust_pay',
1225               'params'  => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1226                                          #agent_custid isn't a cust_pay field, see hash callback
1227               'formats' => { 'simple' => [ qw(custnum agent_custid paid payinfo invnum) ] },
1228               'format_types' => { 'simple' => '' }, #force infer from file extension
1229               'default_csv' => 1, #if it's not .xls, it'll read as csv, regardless of extension
1230               'format_hash_callbacks' => { 'simple' => $hashcb },
1231               'postinsert_callback' => sub {
1232                  my $cust_pay = shift;
1233                  my $cust_main = $cust_pay->cust_main ||
1234                    return "can't find customer to which payments apply";
1235                  my $error = $cust_main->apply_payments_and_credits;
1236                  return $error
1237                    ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1238                    : '';
1239               },
1240             };
1241
1242   FS::Record::process_batch_import( $job, $opt, @_ );
1243
1244 }
1245
1246 =item batch_import HASHREF
1247
1248 Inserts new payments.
1249
1250 =cut
1251
1252 sub batch_import {
1253   my $param = shift;
1254
1255   my $fh       = $param->{filehandle};
1256   my $format   = $param->{'format'};
1257
1258   my $agentnum = $param->{agentnum};
1259   my $_date    = $param->{_date};
1260   $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1261   my $paybatch = $param->{'paybatch'};
1262
1263   my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1264   my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1265
1266   # here is the agent virtualization
1267   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1268
1269   my @fields;
1270   my $payby;
1271   if ( $format eq 'simple' ) {
1272     @fields = qw( custnum agent_custid paid payinfo invnum );
1273     $payby = 'BILL';
1274   } elsif ( $format eq 'extended' ) {
1275     die "unimplemented\n";
1276     @fields = qw( );
1277     $payby = 'BILL';
1278   } else {
1279     die "unknown format $format";
1280   }
1281
1282   eval "use Text::CSV_XS;";
1283   die $@ if $@;
1284
1285   my $csv = new Text::CSV_XS;
1286
1287   my $imported = 0;
1288
1289   local $SIG{HUP} = 'IGNORE';
1290   local $SIG{INT} = 'IGNORE';
1291   local $SIG{QUIT} = 'IGNORE';
1292   local $SIG{TERM} = 'IGNORE';
1293   local $SIG{TSTP} = 'IGNORE';
1294   local $SIG{PIPE} = 'IGNORE';
1295
1296   my $oldAutoCommit = $FS::UID::AutoCommit;
1297   local $FS::UID::AutoCommit = 0;
1298   my $dbh = dbh;
1299   
1300   my $line;
1301   while ( defined($line=<$fh>) ) {
1302
1303     $csv->parse($line) or do {
1304       $dbh->rollback if $oldAutoCommit;
1305       return "can't parse: ". $csv->error_input();
1306     };
1307
1308     my @columns = $csv->fields();
1309
1310     my %cust_pay = (
1311       payby    => $payby,
1312       paybatch => $paybatch,
1313     );
1314     $cust_pay{_date} = $_date if $_date;
1315
1316     my $cust_main;
1317     foreach my $field ( @fields ) {
1318
1319       if ( $field eq 'agent_custid'
1320         && $agentnum
1321         && $columns[0] =~ /\S+/ )
1322       {
1323
1324         my $agent_custid = $columns[0];
1325         my %hash = ( 'agent_custid' => $agent_custid,
1326                      'agentnum'     => $agentnum,
1327                    );
1328
1329         if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1330           $dbh->rollback if $oldAutoCommit;
1331           return "can't specify custnum with agent_custid $agent_custid";
1332         }
1333
1334         $cust_main = qsearchs({
1335                                 'table'     => 'cust_main',
1336                                 'hashref'   => \%hash,
1337                                 'extra_sql' => $extra_sql,
1338                              });
1339
1340         unless ( $cust_main ) {
1341           $dbh->rollback if $oldAutoCommit;
1342           return "can't find customer with agent_custid $agent_custid";
1343         }
1344
1345         $field = 'custnum';
1346         $columns[0] = $cust_main->custnum;
1347       }
1348
1349       $cust_pay{$field} = shift @columns; 
1350     }
1351
1352     if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1353                          && length($1) == $custnum_length ) {
1354       $cust_pay{custnum} = $2;
1355     }
1356
1357     my $custnum = $cust_pay{custnum};
1358
1359     my $cust_pay = new FS::cust_pay( \%cust_pay );
1360     my $error = $cust_pay->insert;
1361
1362     if ( ! $error && $cust_pay->custnum != $custnum ) {
1363       #invnum was defined, and ->insert set custnum to the customer for that
1364       #invoice, but it wasn't the one the import specified.
1365       $dbh->rollback if $oldAutoCommit;
1366       $error = "specified invoice #". $cust_pay{invnum}.
1367                " is for custnum ". $cust_pay->custnum.
1368                ", not specified custnum $custnum";
1369     }
1370
1371     if ( $error ) {
1372       $dbh->rollback if $oldAutoCommit;
1373       return "can't insert payment for $line: $error";
1374     }
1375
1376     if ( $format eq 'simple' ) {
1377       # include agentnum for less surprise?
1378       $cust_main = qsearchs({
1379                              'table'     => 'cust_main',
1380                              'hashref'   => { 'custnum' => $cust_pay->custnum },
1381                              'extra_sql' => $extra_sql,
1382                            })
1383         unless $cust_main;
1384
1385       unless ( $cust_main ) {
1386         $dbh->rollback if $oldAutoCommit;
1387         return "can't find customer to which payments apply at line: $line";
1388       }
1389
1390       $error = $cust_main->apply_payments_and_credits;
1391       if ( $error ) {
1392         $dbh->rollback if $oldAutoCommit;
1393         return "can't apply payments to customer for $line: $error";
1394       }
1395
1396     }
1397
1398     $imported++;
1399   }
1400
1401   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1402
1403   return "Empty file!" unless $imported;
1404
1405   ''; #no error
1406
1407 }
1408
1409 =back
1410
1411 =head1 BUGS
1412
1413 Delete and replace methods.  
1414
1415 =head1 SEE ALSO
1416
1417 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1418 schema.html from the base documentation.
1419
1420 =cut
1421
1422 1;
1423