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