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