fix bad bug in line item generation RT#10024
[freeside.git] / FS / FS / cust_main / Billing.pm
1 package FS::cust_main::Billing;
2
3 use strict;
4 use vars qw( $conf $DEBUG $me );
5 use Carp;
6 use Data::Dumper;
7 use List::Util qw( min );
8 use FS::UID qw( dbh );
9 use FS::Record qw( qsearch qsearchs dbdef );
10 use FS::cust_bill;
11 use FS::cust_bill_pkg;
12 use FS::cust_bill_pkg_display;
13 use FS::cust_bill_pay;
14 use FS::cust_credit_bill;
15 use FS::cust_pkg;
16 use FS::cust_tax_adjustment;
17 use FS::tax_rate;
18 use FS::tax_rate_location;
19 use FS::cust_bill_pkg_tax_location;
20 use FS::cust_bill_pkg_tax_rate_location;
21 use FS::part_event;
22 use FS::part_event_condition;
23
24 # 1 is mostly method/subroutine entry and options
25 # 2 traces progress of some operations
26 # 3 is even more information including possibly sensitive data
27 $DEBUG = 0;
28 $me = '[FS::cust_main::Billing]';
29
30 install_callback FS::UID sub { 
31   $conf = new FS::Conf;
32   #yes, need it for stuff below (prolly should be cached)
33 };
34
35 =head1 NAME
36
37 FS::cust_main::Billing - Billing mixin for cust_main
38
39 =head1 SYNOPSIS
40
41 =head1 DESCRIPTION
42
43 These methods are available on FS::cust_main objects.
44
45 =head1 METHODS
46
47 =over 4
48
49 =item bill_and_collect 
50
51 Cancels and suspends any packages due, generates bills, applies payments and
52 credits, and applies collection events to run cards, send bills and notices,
53 etc.
54
55 By default, warns on errors and continues with the next operation (but see the
56 "fatal" flag below).
57
58 Options are passed as name-value pairs.  Currently available options are:
59
60 =over 4
61
62 =item time
63
64 Bills the customer as if it were that time.  Specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.  For example:
65
66  use Date::Parse;
67  ...
68  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
69
70 =item invoice_time
71
72 Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices.  Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
73
74 =item check_freq
75
76 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
77
78 =item resetup
79
80 If set true, re-charges setup fees.
81
82 =item fatal
83
84 If set any errors prevent subsequent operations from continusing.  If set
85 specifically to "return", returns the error (or false, if there is no error).
86 Any other true value causes errors to die.
87
88 =item debug
89
90 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
91
92 =item job
93
94 Optional FS::queue entry to receive status updates.
95
96 =back
97
98 Options are passed to the B<bill> and B<collect> methods verbatim, so all
99 options of those methods are also available.
100
101 =cut
102
103 sub bill_and_collect {
104   my( $self, %options ) = @_;
105
106   my $error;
107
108   #$options{actual_time} not $options{time} because freeside-daily -d is for
109   #pre-printing invoices
110
111   $options{'actual_time'} ||= time;
112   my $job = $options{'job'};
113
114   $job->update_statustext('0,cleaning expired packages') if $job;
115   $error = $self->cancel_expired_pkgs( $options{actual_time} );
116   if ( $error ) {
117     $error = "Error expiring custnum ". $self->custnum. ": $error";
118     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
119     elsif ( $options{fatal}                                ) { die    $error; }
120     else                                                     { warn   $error; }
121   }
122
123   $error = $self->suspend_adjourned_pkgs( $options{actual_time} );
124   if ( $error ) {
125     $error = "Error adjourning custnum ". $self->custnum. ": $error";
126     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
127     elsif ( $options{fatal}                                ) { die    $error; }
128     else                                                     { warn   $error; }
129   }
130
131   $job->update_statustext('20,billing packages') if $job;
132   $error = $self->bill( %options );
133   if ( $error ) {
134     $error = "Error billing custnum ". $self->custnum. ": $error";
135     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
136     elsif ( $options{fatal}                                ) { die    $error; }
137     else                                                     { warn   $error; }
138   }
139
140   $job->update_statustext('50,applying payments and credits') if $job;
141   $error = $self->apply_payments_and_credits;
142   if ( $error ) {
143     $error = "Error applying custnum ". $self->custnum. ": $error";
144     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
145     elsif ( $options{fatal}                                ) { die    $error; }
146     else                                                     { warn   $error; }
147   }
148
149   $job->update_statustext('70,running collection events') if $job;
150   unless ( $conf->exists('cancelled_cust-noevents')
151            && ! $self->num_ncancelled_pkgs
152   ) {
153     $error = $self->collect( %options );
154     if ( $error ) {
155       $error = "Error collecting custnum ". $self->custnum. ": $error";
156       if    ($options{fatal} && $options{fatal} eq 'return') { return $error; }
157       elsif ($options{fatal}                               ) { die    $error; }
158       else                                                   { warn   $error; }
159     }
160   }
161   $job->update_statustext('100,finished') if $job;
162
163   '';
164
165 }
166
167 sub cancel_expired_pkgs {
168   my ( $self, $time, %options ) = @_;
169
170   my @cancel_pkgs = $self->ncancelled_pkgs( { 
171     'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
172   } );
173
174   my @errors = ();
175
176   foreach my $cust_pkg ( @cancel_pkgs ) {
177     my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
178     my $error = $cust_pkg->cancel($cpr ? ( 'reason'        => $cpr->reasonnum,
179                                            'reason_otaker' => $cpr->otaker
180                                          )
181                                        : ()
182                                  );
183     push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
184   }
185
186   scalar(@errors) ? join(' / ', @errors) : '';
187
188 }
189
190 sub suspend_adjourned_pkgs {
191   my ( $self, $time, %options ) = @_;
192
193   my @susp_pkgs = $self->ncancelled_pkgs( {
194     'extra_sql' =>
195       " AND ( susp IS NULL OR susp = 0 )
196         AND (    ( bill    IS NOT NULL AND bill    != 0 AND bill    <  $time )
197               OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
198             )
199       ",
200   } );
201
202   #only because there's no SQL test for is_prepaid :/
203   @susp_pkgs = 
204     grep {     (    $_->part_pkg->is_prepaid
205                  && $_->bill
206                  && $_->bill < $time
207                )
208             || (    $_->adjourn
209                  && $_->adjourn <= $time
210                )
211            
212          }
213          @susp_pkgs;
214
215   my @errors = ();
216
217   foreach my $cust_pkg ( @susp_pkgs ) {
218     my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
219       if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
220     my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
221                                             'reason_otaker' => $cpr->otaker
222                                           )
223                                         : ()
224                                   );
225     push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
226   }
227
228   scalar(@errors) ? join(' / ', @errors) : '';
229
230 }
231
232 =item bill OPTIONS
233
234 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
235 conjunction with the collect method by calling B<bill_and_collect>.
236
237 If there is an error, returns the error, otherwise returns false.
238
239 Options are passed as name-value pairs.  Currently available options are:
240
241 =over 4
242
243 =item resetup
244
245 If set true, re-charges setup fees.
246
247 =item recurring_only
248
249 If set true then only bill recurring charges, not setup, usage, one time
250 charges, etc.
251
252 =item freq_override
253
254 If set, then override the normal frequency and look for a part_pkg_discount
255 to take at that frequency.
256
257 =item time
258
259 Bills the customer as if it were that time.  Specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.  For example:
260
261  use Date::Parse;
262  ...
263  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
264
265 =item pkg_list
266
267 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
268
269  $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
270
271 =item not_pkgpart
272
273 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
274
275 =item invoice_time
276
277 Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices.  Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
278
279 =item cancel
280
281 This boolean value informs the us that the package is being cancelled.  This
282 typically might mean not charging the normal recurring fee but only usage
283 fees since the last billing. Setup charges may be charged.  Not all package
284 plans support this feature (they tend to charge 0).
285
286 =item no_usage_reset
287
288 Prevent the resetting of usage limits during this call.
289
290 =item no_commit
291
292 Do not save the generated bill in the database.  Useful with return_bill
293
294 =item return_bill
295
296 A list reference on which the generated bill(s) will be returned.
297
298 =item invoice_terms
299
300 Optional terms to be printed on this invoice.  Otherwise, customer-specific
301 terms or the default terms are used.
302
303 =back
304
305 =cut
306
307 sub bill {
308   my( $self, %options ) = @_;
309
310   return '' if $self->payby eq 'COMP';
311
312   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
313
314   warn "$me bill customer ". $self->custnum. "\n"
315     if $DEBUG;
316
317   my $time = $options{'time'} || time;
318   my $invoice_time = $options{'invoice_time'} || $time;
319
320   $options{'not_pkgpart'} ||= {};
321   $options{'not_pkgpart'} = { map { $_ => 1 }
322                                   split(/\s*,\s*/, $options{'not_pkgpart'})
323                             }
324     unless ref($options{'not_pkgpart'});
325
326   local $SIG{HUP} = 'IGNORE';
327   local $SIG{INT} = 'IGNORE';
328   local $SIG{QUIT} = 'IGNORE';
329   local $SIG{TERM} = 'IGNORE';
330   local $SIG{TSTP} = 'IGNORE';
331   local $SIG{PIPE} = 'IGNORE';
332
333   my $oldAutoCommit = $FS::UID::AutoCommit;
334   local $FS::UID::AutoCommit = 0;
335   my $dbh = dbh;
336
337   warn "$me acquiring lock on customer ". $self->custnum. "\n"
338     if $DEBUG;
339
340   $self->select_for_update; #mutex
341
342   warn "$me running pre-bill events for customer ". $self->custnum. "\n"
343     if $DEBUG;
344
345   my $error = $self->do_cust_event(
346     'debug'      => ( $options{'debug'} || 0 ),
347     'time'       => $invoice_time,
348     'check_freq' => $options{'check_freq'},
349     'stage'      => 'pre-bill',
350   )
351     unless $options{no_commit};
352   if ( $error ) {
353     $dbh->rollback if $oldAutoCommit && !$options{no_commit};
354     return $error;
355   }
356
357   warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
358     if $DEBUG;
359
360   #keep auto-charge and non-auto-charge line items separate
361   my @passes = ( '', 'no_auto' );
362
363   my %cust_bill_pkg = map { $_ => [] } @passes;
364
365   ###
366   # find the packages which are due for billing, find out how much they are
367   # & generate invoice database.
368   ###
369
370   my %total_setup   = map { my $z = 0; $_ => \$z; } @passes;
371   my %total_recur   = map { my $z = 0; $_ => \$z; } @passes;
372
373   my %taxlisthash = map { $_ => {} } @passes;
374
375   my @precommit_hooks = ();
376
377   $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ];  #param checks?
378   foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
379
380     next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
381
382     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
383
384     #? to avoid use of uninitialized value errors... ?
385     $cust_pkg->setfield('bill', '')
386       unless defined($cust_pkg->bill);
387  
388     #my $part_pkg = $cust_pkg->part_pkg;
389
390     my $real_pkgpart = $cust_pkg->pkgpart;
391     my %hash = $cust_pkg->hash;
392
393     # we could implement this bit as FS::part_pkg::has_hidden, but we already
394     # suffer from performance issues
395     $options{has_hidden} = 0;
396     my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked;
397     $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
398  
399     foreach my $part_pkg ( @part_pkg ) {
400
401       $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
402
403       my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
404
405       my $error =
406         $self->_make_lines( 'part_pkg'            => $part_pkg,
407                             'cust_pkg'            => $cust_pkg,
408                             'precommit_hooks'     => \@precommit_hooks,
409                             'line_items'          => $cust_bill_pkg{$pass},
410                             'setup'               => $total_setup{$pass},
411                             'recur'               => $total_recur{$pass},
412                             'tax_matrix'          => $taxlisthash{$pass},
413                             'time'                => $time,
414                             'real_pkgpart'        => $real_pkgpart,
415                             'options'             => \%options,
416                           );
417       if ($error) {
418         $dbh->rollback if $oldAutoCommit && !$options{no_commit};
419         return $error;
420       }
421
422     } #foreach my $part_pkg
423
424   } #foreach my $cust_pkg
425
426   #if the customer isn't on an automatic payby, everything can go on a single
427   #invoice anyway?
428   #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) {
429     #merge everything into one list
430   #}
431
432   foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
433
434     my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
435
436     next unless @cust_bill_pkg; #don't create an invoice w/o line items
437
438     warn "$me billing pass $pass\n"
439            #.Dumper(\@cust_bill_pkg)."\n"
440       if $DEBUG > 2;
441
442     if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
443            !$conf->exists('postal_invoice-recurring_only')
444        )
445     {
446
447       my $postal_pkg = $self->charge_postal_fee();
448       if ( $postal_pkg && !ref( $postal_pkg ) ) {
449
450         $dbh->rollback if $oldAutoCommit && !$options{no_commit};
451         return "can't charge postal invoice fee for customer ".
452           $self->custnum. ": $postal_pkg";
453
454       } elsif ( $postal_pkg ) {
455
456         my $real_pkgpart = $postal_pkg->pkgpart;
457         # we could implement this bit as FS::part_pkg::has_hidden, but we already
458         # suffer from performance issues
459         $options{has_hidden} = 0;
460         my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
461         $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
462
463         foreach my $part_pkg ( @part_pkg ) {
464           my %postal_options = %options;
465           delete $postal_options{cancel};
466           my $error =
467             $self->_make_lines( 'part_pkg'            => $part_pkg,
468                                 'cust_pkg'            => $postal_pkg,
469                                 'precommit_hooks'     => \@precommit_hooks,
470                                 'line_items'          => \@cust_bill_pkg,
471                                 'setup'               => $total_setup{$pass},
472                                 'recur'               => $total_recur{$pass},
473                                 'tax_matrix'          => $taxlisthash{$pass},
474                                 'time'                => $time,
475                                 'real_pkgpart'        => $real_pkgpart,
476                                 'options'             => \%postal_options,
477                               );
478           if ($error) {
479             $dbh->rollback if $oldAutoCommit && !$options{no_commit};
480             return $error;
481           }
482         }
483
484         # it's silly to have a zero value postal_pkg, but....
485         @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
486
487       }
488
489     }
490
491     my $listref_or_error =
492       $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
493
494     unless ( ref( $listref_or_error ) ) {
495       $dbh->rollback if $oldAutoCommit && !$options{no_commit};
496       return $listref_or_error;
497     }
498
499     foreach my $taxline ( @$listref_or_error ) {
500       ${ $total_setup{$pass} } =
501         sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
502       push @cust_bill_pkg, $taxline;
503     }
504
505     #add tax adjustments
506     warn "adding tax adjustments...\n" if $DEBUG > 2;
507     foreach my $cust_tax_adjustment (
508       qsearch('cust_tax_adjustment', { 'custnum'    => $self->custnum,
509                                        'billpkgnum' => '',
510                                      }
511              )
512     ) {
513
514       my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
515
516       my $itemdesc = $cust_tax_adjustment->taxname;
517       $itemdesc = '' if $itemdesc eq 'Tax';
518
519       push @cust_bill_pkg, new FS::cust_bill_pkg {
520         'pkgnum'      => 0,
521         'setup'       => $tax,
522         'recur'       => 0,
523         'sdate'       => '',
524         'edate'       => '',
525         'itemdesc'    => $itemdesc,
526         'itemcomment' => $cust_tax_adjustment->comment,
527         'cust_tax_adjustment' => $cust_tax_adjustment,
528         #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
529       };
530
531     }
532
533     my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
534
535     my @cust_bill = $self->cust_bill;
536     my $balance = $self->balance;
537     my $previous_balance = scalar(@cust_bill)
538                              ? ( $cust_bill[$#cust_bill]->billing_balance || 0 )
539                              : 0;
540
541     $previous_balance += $cust_bill[$#cust_bill]->charged
542       if scalar(@cust_bill);
543     #my $balance_adjustments =
544     #  sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
545
546     warn "creating the new invoice\n" if $DEBUG;
547     #create the new invoice
548     my $cust_bill = new FS::cust_bill ( {
549       'custnum'             => $self->custnum,
550       '_date'               => ( $invoice_time ),
551       'charged'             => $charged,
552       'billing_balance'     => $balance,
553       'previous_balance'    => $previous_balance,
554       'invoice_terms'       => $options{'invoice_terms'},
555       'cust_bill_pkg'       => \@cust_bill_pkg,
556     } );
557     $error = $cust_bill->insert unless $options{no_commit};
558     if ( $error ) {
559       $dbh->rollback if $oldAutoCommit && !$options{no_commit};
560       return "can't create invoice for customer #". $self->custnum. ": $error";
561     }
562     push @{$options{return_bill}}, $cust_bill if $options{return_bill};
563
564   } #foreach my $pass ( keys %cust_bill_pkg )
565
566   foreach my $hook ( @precommit_hooks ) { 
567     eval {
568       &{$hook}; #($self) ?
569     } unless $options{no_commit};
570     if ( $@ ) {
571       $dbh->rollback if $oldAutoCommit && !$options{no_commit};
572       return "$@ running precommit hook $hook\n";
573     }
574   }
575   
576   $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
577
578   ''; #no error
579 }
580
581 #discard bundled packages of 0 value
582 sub _omit_zero_value_bundles {
583
584   my @cust_bill_pkg = ();
585   my @cust_bill_pkg_bundle = ();
586   my $sum = 0;
587
588   foreach my $cust_bill_pkg ( @_ ) {
589     if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) {
590       push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0;
591       @cust_bill_pkg_bundle = ();
592       $sum = 0;
593     }
594     $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur;
595     push @cust_bill_pkg_bundle, $cust_bill_pkg;
596   }
597   push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0;
598
599   (@cust_bill_pkg);
600
601 }
602
603 =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
604
605 This is a weird one.  Perhaps it should not even be exposed.
606
607 Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
608 Usually used internally by bill method B<bill>.
609
610 If there is an error, returns the error, otherwise returns reference to a
611 list of line items suitable for insertion.
612
613 =over 4
614
615 =item LINEITEMREF
616
617 An array ref of the line items being billed.
618
619 =item TAXHASHREF
620
621 A strange beast.  The keys to this hash are internal identifiers consisting
622 of the name of the tax object type, a space, and its unique identifier ( e.g.
623  'cust_main_county 23' ).  The values of the hash are listrefs.  The first
624 item in the list is the tax object.  The remaining items are either line
625 items or floating point values (currency amounts).
626
627 The taxes are calculated on this entity.  Calculated exemption records are
628 transferred to the LINEITEMREF items on the assumption that they are related.
629
630 Read the source.
631
632 =item INVOICE_TIME
633
634 This specifies the date appearing on the associated invoice.  Some
635 jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
636
637 =back
638
639 =cut
640
641 sub calculate_taxes {
642   my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
643
644   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
645
646   warn "$me calculate_taxes\n"
647        #.Dumper($self, $cust_bill_pkg, $taxlisthash, $invoice_time). "\n"
648     if $DEBUG > 2;
649
650   my @tax_line_items = ();
651
652   # keys are tax names (as printed on invoices / itemdesc )
653   # values are listrefs of taxlisthash keys (internal identifiers)
654   my %taxname = ();
655
656   # keys are taxlisthash keys (internal identifiers)
657   # values are (cumulative) amounts
658   my %tax = ();
659
660   # keys are taxlisthash keys (internal identifiers)
661   # values are listrefs of cust_bill_pkg_tax_location hashrefs
662   my %tax_location = ();
663
664   # keys are taxlisthash keys (internal identifiers)
665   # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
666   my %tax_rate_location = ();
667
668   foreach my $tax ( keys %$taxlisthash ) {
669     my $tax_object = shift @{ $taxlisthash->{$tax} };
670     warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
671     warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
672     my $hashref_or_error =
673       $tax_object->taxline( $taxlisthash->{$tax},
674                             'custnum'      => $self->custnum,
675                             'invoice_time' => $invoice_time
676                           );
677     return $hashref_or_error unless ref($hashref_or_error);
678
679     unshift @{ $taxlisthash->{$tax} }, $tax_object;
680
681     my $name   = $hashref_or_error->{'name'};
682     my $amount = $hashref_or_error->{'amount'};
683
684     #warn "adding $amount as $name\n";
685     $taxname{ $name } ||= [];
686     push @{ $taxname{ $name } }, $tax;
687
688     $tax{ $tax } += $amount;
689
690     $tax_location{ $tax } ||= [];
691     if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
692       push @{ $tax_location{ $tax }  },
693         {
694           'taxnum'      => $tax_object->taxnum, 
695           'taxtype'     => ref($tax_object),
696           'pkgnum'      => $tax_object->get('pkgnum'),
697           'locationnum' => $tax_object->get('locationnum'),
698           'amount'      => sprintf('%.2f', $amount ),
699         };
700     }
701
702     $tax_rate_location{ $tax } ||= [];
703     if ( ref($tax_object) eq 'FS::tax_rate' ) {
704       my $taxratelocationnum =
705         $tax_object->tax_rate_location->taxratelocationnum;
706       push @{ $tax_rate_location{ $tax }  },
707         {
708           'taxnum'             => $tax_object->taxnum, 
709           'taxtype'            => ref($tax_object),
710           'amount'             => sprintf('%.2f', $amount ),
711           'locationtaxid'      => $tax_object->location,
712           'taxratelocationnum' => $taxratelocationnum,
713         };
714     }
715
716   }
717
718   #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
719   my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg;
720   foreach my $tax ( keys %$taxlisthash ) {
721     foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) {
722       next unless ref($_) eq 'FS::cust_bill_pkg';
723       push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg }, 
724         splice( @{ $_->_cust_tax_exempt_pkg } );
725     }
726   }
727
728   #consolidate and create tax line items
729   warn "consolidating and generating...\n" if $DEBUG > 2;
730   foreach my $taxname ( keys %taxname ) {
731     my $tax = 0;
732     my %seen = ();
733     my @cust_bill_pkg_tax_location = ();
734     my @cust_bill_pkg_tax_rate_location = ();
735     warn "adding $taxname\n" if $DEBUG > 1;
736     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
737       next if $seen{$taxitem}++;
738       warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
739       $tax += $tax{$taxitem};
740       push @cust_bill_pkg_tax_location,
741         map { new FS::cust_bill_pkg_tax_location $_ }
742             @{ $tax_location{ $taxitem } };
743       push @cust_bill_pkg_tax_rate_location,
744         map { new FS::cust_bill_pkg_tax_rate_location $_ }
745             @{ $tax_rate_location{ $taxitem } };
746     }
747     next unless $tax;
748
749     $tax = sprintf('%.2f', $tax );
750   
751     my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
752                                                    'disabled'     => '',
753                                                  },
754                                );
755
756     my @display = ();
757     if ( $pkg_category and
758          $conf->config('invoice_latexsummary') ||
759          $conf->config('invoice_htmlsummary')
760        )
761     {
762
763       my %hash = (  'section' => $pkg_category->categoryname );
764       push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
765
766     }
767
768     push @tax_line_items, new FS::cust_bill_pkg {
769       'pkgnum'   => 0,
770       'setup'    => $tax,
771       'recur'    => 0,
772       'sdate'    => '',
773       'edate'    => '',
774       'itemdesc' => $taxname,
775       'display'  => \@display,
776       'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
777       'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
778     };
779
780   }
781
782   \@tax_line_items;
783 }
784
785 sub _make_lines {
786   my ($self, %params) = @_;
787
788   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
789
790   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
791   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
792   my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
793   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
794   my $total_setup = $params{setup} or die "no setup accumulator specified";
795   my $total_recur = $params{recur} or die "no recur accumulator specified";
796   my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
797   my $time = $params{'time'} or die "no time specified";
798   my (%options) = %{$params{options}};
799
800   my $dbh = dbh;
801   my $real_pkgpart = $params{real_pkgpart};
802   my %hash = $cust_pkg->hash;
803   my $old_cust_pkg = new FS::cust_pkg \%hash;
804
805   my @details = ();
806   my @discounts = ();
807   my $lineitems = 0;
808
809   $cust_pkg->pkgpart($part_pkg->pkgpart);
810
811   ###
812   # bill setup
813   ###
814
815   my $setup = 0;
816   my $unitsetup = 0;
817   if ( $options{'resetup'}
818        || ( ! $cust_pkg->setup
819             && ( ! $cust_pkg->start_date
820                  || $cust_pkg->start_date <= $time
821                )
822             && ( ! $conf->exists('disable_setup_suspended_pkgs')
823                  || ( $conf->exists('disable_setup_suspended_pkgs') &&
824                       ! $cust_pkg->getfield('susp')
825                     )
826                )
827           )
828         and !$options{recurring_only}
829     )
830   {
831     
832     warn "    bill setup\n" if $DEBUG > 1;
833     $lineitems++;
834
835     $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
836     return "$@ running calc_setup for $cust_pkg\n"
837       if $@;
838
839     $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
840
841     $cust_pkg->setfield('setup', $time)
842       unless $cust_pkg->setup;
843           #do need it, but it won't get written to the db
844           #|| $cust_pkg->pkgpart != $real_pkgpart;
845
846     $cust_pkg->setfield('start_date', '')
847       if $cust_pkg->start_date;
848
849   }
850
851   ###
852   # bill recurring fee
853   ### 
854
855   #XXX unit stuff here too
856   my $recur = 0;
857   my $unitrecur = 0;
858   my $sdate;
859   if (     ! $cust_pkg->get('susp')
860        and ! $cust_pkg->get('start_date')
861        and ( $part_pkg->getfield('freq') ne '0'
862              && ( $cust_pkg->getfield('bill') || 0 ) <= $time
863            )
864         || ( $part_pkg->plan eq 'voip_cdr'
865               && $part_pkg->option('bill_every_call')
866            )
867         || ( $options{cancel} )
868   ) {
869
870     # XXX should this be a package event?  probably.  events are called
871     # at collection time at the moment, though...
872     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
873       if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
874       #don't want to reset usage just cause we want a line item??
875       #&& $part_pkg->pkgpart == $real_pkgpart;
876
877     warn "    bill recur\n" if $DEBUG > 1;
878     $lineitems++;
879
880     # XXX shared with $recur_prog
881     $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
882              || $cust_pkg->setup
883              || $time;
884
885     #over two params!  lets at least switch to a hashref for the rest...
886     my $increment_next_bill = ( $part_pkg->freq ne '0'
887                                 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
888                                 && !$options{cancel}
889                               );
890     my %param = ( 'precommit_hooks'     => $precommit_hooks,
891                   'increment_next_bill' => $increment_next_bill,
892                   'discounts'           => \@discounts,
893                   'real_pkgpart'        => $real_pkgpart,
894                   'freq_override'       => $options{freq_override} || '',
895                 );
896
897     my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
898
899     # There may be some part_pkg for which this is wrong.  Only those
900     # which can_discount are supported.
901
902     $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
903     return "$@ running $method for $cust_pkg\n"
904       if ( $@ );
905
906     if ( $increment_next_bill ) {
907
908       my $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
909       return "unparsable frequency: ". $part_pkg->freq
910         if $next_bill == -1;
911   
912       #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
913       # only for figuring next bill date, nothing else, so, reset $sdate again
914       # here
915       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
916       #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
917       $cust_pkg->last_bill($sdate);
918
919       $cust_pkg->setfield('bill', $next_bill );
920
921     }
922
923   }
924
925   warn "\$setup is undefined" unless defined($setup);
926   warn "\$recur is undefined" unless defined($recur);
927   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
928   
929   ###
930   # If there's line items, create em cust_bill_pkg records
931   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
932   ###
933
934   if ( $lineitems ) {
935
936     if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
937       # hmm.. and if just the options are modified in some weird price plan?
938   
939       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
940         if $DEBUG >1;
941   
942       my $error = $cust_pkg->replace( $old_cust_pkg,
943                                       'options' => { $cust_pkg->options },
944                                     )
945         unless $options{no_commit};
946       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
947         if $error; #just in case
948     }
949   
950     $setup = sprintf( "%.2f", $setup );
951     $recur = sprintf( "%.2f", $recur );
952     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
953       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
954     }
955     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
956       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
957     }
958
959     if ( $setup != 0 ||
960          $recur != 0 ||
961          !$part_pkg->hidden && $options{has_hidden} ) #include some $0 lines
962     {
963
964       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
965         if $DEBUG > 1;
966
967       my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
968       if ( $DEBUG > 1 ) {
969         warn "      adding customer package invoice detail: $_\n"
970           foreach @cust_pkg_detail;
971       }
972       push @details, @cust_pkg_detail;
973
974       my $cust_bill_pkg = new FS::cust_bill_pkg {
975         'pkgnum'    => $cust_pkg->pkgnum,
976         'setup'     => $setup,
977         'unitsetup' => $unitsetup,
978         'recur'     => $recur,
979         'unitrecur' => $unitrecur,
980         'quantity'  => $cust_pkg->quantity,
981         'details'   => \@details,
982         'discounts' => \@discounts,
983         'hidden'    => $part_pkg->hidden,
984         'freq'      => $part_pkg->freq,
985       };
986
987       if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
988         $cust_bill_pkg->sdate( $hash{last_bill} );
989         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
990         $cust_bill_pkg->edate( $time ) if $options{cancel};
991       } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
992         $cust_bill_pkg->sdate( $sdate );
993         $cust_bill_pkg->edate( $cust_pkg->bill );
994         #$cust_bill_pkg->edate( $time ) if $options{cancel};
995       }
996
997       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
998         unless $part_pkg->pkgpart == $real_pkgpart;
999
1000       $$total_setup += $setup;
1001       $$total_recur += $recur;
1002
1003       ###
1004       # handle taxes
1005       ###
1006
1007       my $error = 
1008         $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
1009       return $error if $error;
1010
1011       push @$cust_bill_pkgs, $cust_bill_pkg;
1012
1013     } #if $setup != 0 || $recur != 0
1014       
1015   } #if $line_items
1016
1017   '';
1018
1019 }
1020
1021 sub _handle_taxes {
1022   my $self = shift;
1023   my $part_pkg = shift;
1024   my $taxlisthash = shift;
1025   my $cust_bill_pkg = shift;
1026   my $cust_pkg = shift;
1027   my $invoice_time = shift;
1028   my $real_pkgpart = shift;
1029   my $options = shift;
1030
1031   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1032
1033   my %cust_bill_pkg = ();
1034   my %taxes = ();
1035     
1036   my @classes;
1037   #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
1038   push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
1039   push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
1040   push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
1041
1042   if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
1043
1044     if ( $conf->exists('enable_taxproducts')
1045          && ( scalar($part_pkg->part_pkg_taxoverride)
1046               || $part_pkg->has_taxproduct
1047             )
1048        )
1049     {
1050
1051       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
1052         return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
1053       }
1054
1055       foreach my $class (@classes) {
1056         my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
1057         return $err_or_ref unless ref($err_or_ref);
1058         $taxes{$class} = $err_or_ref;
1059       }
1060
1061       unless (exists $taxes{''}) {
1062         my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
1063         return $err_or_ref unless ref($err_or_ref);
1064         $taxes{''} = $err_or_ref;
1065       }
1066
1067     } else {
1068
1069       my @loc_keys = qw( city county state country );
1070       my %taxhash;
1071       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
1072         my $cust_location = $cust_pkg->cust_location;
1073         %taxhash = map { $_ => $cust_location->$_()    } @loc_keys;
1074       } else {
1075         my $prefix = 
1076           ( $conf->exists('tax-ship_address') && length($self->ship_last) )
1077           ? 'ship_'
1078           : '';
1079         %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
1080       }
1081
1082       $taxhash{'taxclass'} = $part_pkg->taxclass;
1083
1084       my @taxes = ();
1085       my %taxhash_elim = %taxhash;
1086       my @elim = qw( city county state );
1087       do { 
1088
1089         #first try a match with taxclass
1090         @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1091
1092         if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1093           #then try a match without taxclass
1094           my %no_taxclass = %taxhash_elim;
1095           $no_taxclass{ 'taxclass' } = '';
1096           @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1097         }
1098
1099         $taxhash_elim{ shift(@elim) } = '';
1100
1101       } while ( !scalar(@taxes) && scalar(@elim) );
1102
1103       @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
1104                     @taxes
1105         if $self->cust_main_exemption; #just to be safe
1106
1107       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
1108         foreach (@taxes) {
1109           $_->set('pkgnum',      $cust_pkg->pkgnum );
1110           $_->set('locationnum', $cust_pkg->locationnum );
1111         }
1112       }
1113
1114       $taxes{''} = [ @taxes ];
1115       $taxes{'setup'} = [ @taxes ];
1116       $taxes{'recur'} = [ @taxes ];
1117       $taxes{$_} = [ @taxes ] foreach (@classes);
1118
1119       # # maybe eliminate this entirely, along with all the 0% records
1120       # unless ( @taxes ) {
1121       #   return
1122       #     "fatal: can't find tax rate for state/county/country/taxclass ".
1123       #     join('/', map $taxhash{$_}, qw(state county country taxclass) );
1124       # }
1125
1126     } #if $conf->exists('enable_taxproducts') ...
1127
1128   }
1129  
1130   my @display = ();
1131   my $separate = $conf->exists('separate_usage');
1132   my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart };
1133   my $usage_mandate = $temp_pkg->part_pkg->option('usage_mandate', 'Hush!');
1134   my $section = $temp_pkg->part_pkg->categoryname;
1135   if ( $separate || $section || $usage_mandate ) {
1136
1137     my %hash = ( 'section' => $section );
1138
1139     $section = $temp_pkg->part_pkg->option('usage_section', 'Hush!');
1140     my $summary = $temp_pkg->part_pkg->option('summarize_usage', 'Hush!');
1141     if ( $separate ) {
1142       push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
1143       push @display, new FS::cust_bill_pkg_display { type => 'R', %hash };
1144     } else {
1145       push @display, new FS::cust_bill_pkg_display
1146                        { type => '',
1147                          %hash,
1148                          ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
1149                        };
1150     }
1151
1152     if ($separate && $section && $summary) {
1153       push @display, new FS::cust_bill_pkg_display { type    => 'U',
1154                                                      summary => 'Y',
1155                                                      %hash,
1156                                                    };
1157     }
1158     if ($usage_mandate || $section && $summary) {
1159       $hash{post_total} = 'Y';
1160     }
1161
1162     if ($separate || $usage_mandate) {
1163       $hash{section} = $section if ($separate || $usage_mandate);
1164       push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
1165     }
1166
1167   }
1168   $cust_bill_pkg->set('display', \@display);
1169
1170   my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
1171   foreach my $key (keys %tax_cust_bill_pkg) {
1172     my @taxes = @{ $taxes{$key} || [] };
1173     my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
1174
1175     my %localtaxlisthash = ();
1176     foreach my $tax ( @taxes ) {
1177
1178       my $taxname = ref( $tax ). ' '. $tax->taxnum;
1179 #      $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
1180 #                  ' locationnum'. $cust_pkg->locationnum
1181 #        if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
1182
1183       $taxlisthash->{ $taxname } ||= [ $tax ];
1184       push @{ $taxlisthash->{ $taxname  } }, $tax_cust_bill_pkg;
1185
1186       $localtaxlisthash{ $taxname } ||= [ $tax ];
1187       push @{ $localtaxlisthash{ $taxname  } }, $tax_cust_bill_pkg;
1188
1189     }
1190
1191     warn "finding taxed taxes...\n" if $DEBUG > 2;
1192     foreach my $tax ( keys %localtaxlisthash ) {
1193       my $tax_object = shift @{ $localtaxlisthash{$tax} };
1194       warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
1195         if $DEBUG > 2;
1196       next unless $tax_object->can('tax_on_tax');
1197
1198       foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
1199         my $totname = ref( $tot ). ' '. $tot->taxnum;
1200
1201         warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
1202           if $DEBUG > 2;
1203         next unless exists( $localtaxlisthash{ $totname } ); # only increase
1204                                                              # existing taxes
1205         warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
1206         my $hashref_or_error = 
1207           $tax_object->taxline( $localtaxlisthash{$tax},
1208                                 'custnum'      => $self->custnum,
1209                                 'invoice_time' => $invoice_time,
1210                               );
1211         return $hashref_or_error
1212           unless ref($hashref_or_error);
1213         
1214         $taxlisthash->{ $totname } ||= [ $tot ];
1215         push @{ $taxlisthash->{ $totname  } }, $hashref_or_error->{amount};
1216
1217       }
1218     }
1219
1220   }
1221
1222   '';
1223 }
1224
1225 sub _gather_taxes {
1226   my $self = shift;
1227   my $part_pkg = shift;
1228   my $class = shift;
1229
1230   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1231
1232   my @taxes = ();
1233   my $geocode = $self->geocode('cch');
1234
1235   my @taxclassnums = map { $_->taxclassnum }
1236                      $part_pkg->part_pkg_taxoverride($class);
1237
1238   unless (@taxclassnums) {
1239     @taxclassnums = map { $_->taxclassnum }
1240                     grep { $_->taxable eq 'Y' }
1241                     $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
1242   }
1243   warn "Found taxclassnum values of ". join(',', @taxclassnums)
1244     if $DEBUG;
1245
1246   my $extra_sql =
1247     "AND (".
1248     join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
1249
1250   @taxes = qsearch({ 'table' => 'tax_rate',
1251                      'hashref' => { 'geocode' => $geocode, },
1252                      'extra_sql' => $extra_sql,
1253                   })
1254     if scalar(@taxclassnums);
1255
1256   warn "Found taxes ".
1257        join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n" 
1258    if $DEBUG;
1259
1260   [ @taxes ];
1261
1262 }
1263
1264 =item collect [ HASHREF | OPTION => VALUE ... ]
1265
1266 (Attempt to) collect money for this customer's outstanding invoices (see
1267 L<FS::cust_bill>).  Usually used after the bill method.
1268
1269 Actions are now triggered by billing events; see L<FS::part_event> and the
1270 billing events web interface.  Old-style invoice events (see
1271 L<FS::part_bill_event>) have been deprecated.
1272
1273 If there is an error, returns the error, otherwise returns false.
1274
1275 Options are passed as name-value pairs.
1276
1277 Currently available options are:
1278
1279 =over 4
1280
1281 =item invoice_time
1282
1283 Use this time when deciding when to print invoices and late notices on those invoices.  The default is now.  It is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.
1284
1285 =item retry
1286
1287 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1288
1289 =item check_freq
1290
1291 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1292
1293 =item quiet
1294
1295 set true to surpress email card/ACH decline notices.
1296
1297 =item debug
1298
1299 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
1300
1301 =back
1302
1303 # =item payby
1304 #
1305 # allows for one time override of normal customer billing method
1306
1307 =cut
1308
1309 sub collect {
1310   my( $self, %options ) = @_;
1311
1312   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1313
1314   my $invoice_time = $options{'invoice_time'} || time;
1315
1316   #put below somehow?
1317   local $SIG{HUP} = 'IGNORE';
1318   local $SIG{INT} = 'IGNORE';
1319   local $SIG{QUIT} = 'IGNORE';
1320   local $SIG{TERM} = 'IGNORE';
1321   local $SIG{TSTP} = 'IGNORE';
1322   local $SIG{PIPE} = 'IGNORE';
1323
1324   my $oldAutoCommit = $FS::UID::AutoCommit;
1325   local $FS::UID::AutoCommit = 0;
1326   my $dbh = dbh;
1327
1328   $self->select_for_update; #mutex
1329
1330   if ( $DEBUG ) {
1331     my $balance = $self->balance;
1332     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1333   }
1334
1335   if ( exists($options{'retry_card'}) ) {
1336     carp 'retry_card option passed to collect is deprecated; use retry';
1337     $options{'retry'} ||= $options{'retry_card'};
1338   }
1339   if ( exists($options{'retry'}) && $options{'retry'} ) {
1340     my $error = $self->retry_realtime;
1341     if ( $error ) {
1342       $dbh->rollback if $oldAutoCommit;
1343       return $error;
1344     }
1345   }
1346
1347   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1348
1349   #never want to roll back an event just because it returned an error
1350   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1351
1352   $self->do_cust_event(
1353     'debug'      => ( $options{'debug'} || 0 ),
1354     'time'       => $invoice_time,
1355     'check_freq' => $options{'check_freq'},
1356     'stage'      => 'collect',
1357   );
1358
1359 }
1360
1361 =item retry_realtime
1362
1363 Schedules realtime / batch  credit card / electronic check / LEC billing
1364 events for for retry.  Useful if card information has changed or manual
1365 retry is desired.  The 'collect' method must be called to actually retry
1366 the transaction.
1367
1368 Implementation details: For either this customer, or for each of this
1369 customer's open invoices, changes the status of the first "done" (with
1370 statustext error) realtime processing event to "failed".
1371
1372 =cut
1373
1374 sub retry_realtime {
1375   my $self = shift;
1376
1377   local $SIG{HUP} = 'IGNORE';
1378   local $SIG{INT} = 'IGNORE';
1379   local $SIG{QUIT} = 'IGNORE';
1380   local $SIG{TERM} = 'IGNORE';
1381   local $SIG{TSTP} = 'IGNORE';
1382   local $SIG{PIPE} = 'IGNORE';
1383
1384   my $oldAutoCommit = $FS::UID::AutoCommit;
1385   local $FS::UID::AutoCommit = 0;
1386   my $dbh = dbh;
1387
1388   #a little false laziness w/due_cust_event (not too bad, really)
1389
1390   my $join = FS::part_event_condition->join_conditions_sql;
1391   my $order = FS::part_event_condition->order_conditions_sql;
1392   my $mine = 
1393   '( '
1394    . join ( ' OR ' , map { 
1395     "( part_event.eventtable = " . dbh->quote($_) 
1396     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
1397    } FS::part_event->eventtables)
1398    . ') ';
1399
1400   #here is the agent virtualization
1401   my $agent_virt = " (    part_event.agentnum IS NULL
1402                        OR part_event.agentnum = ". $self->agentnum. ' )';
1403
1404   #XXX this shouldn't be hardcoded, actions should declare it...
1405   my @realtime_events = qw(
1406     cust_bill_realtime_card
1407     cust_bill_realtime_check
1408     cust_bill_realtime_lec
1409     cust_bill_batch
1410   );
1411
1412   my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
1413                                                   @realtime_events
1414                                      ).
1415                           ' ) ';
1416
1417   my @cust_event = qsearchs({
1418     'table'     => 'cust_event',
1419     'select'    => 'cust_event.*',
1420     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
1421     'hashref'   => { 'status' => 'done' },
1422     'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
1423                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
1424   });
1425
1426   my %seen_invnum = ();
1427   foreach my $cust_event (@cust_event) {
1428
1429     #max one for the customer, one for each open invoice
1430     my $cust_X = $cust_event->cust_X;
1431     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
1432                           ? $cust_X->invnum
1433                           : 0
1434                         }++
1435          or $cust_event->part_event->eventtable eq 'cust_bill'
1436             && ! $cust_X->owed;
1437
1438     my $error = $cust_event->retry;
1439     if ( $error ) {
1440       $dbh->rollback if $oldAutoCommit;
1441       return "error scheduling event for retry: $error";
1442     }
1443
1444   }
1445
1446   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1447   '';
1448
1449 }
1450
1451 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
1452
1453 Runs billing events; see L<FS::part_event> and the billing events web
1454 interface.
1455
1456 If there is an error, returns the error, otherwise returns false.
1457
1458 Options are passed as name-value pairs.
1459
1460 Currently available options are:
1461
1462 =over 4
1463
1464 =item time
1465
1466 Use this time when deciding when to print invoices and late notices on those invoices.  The default is now.  It is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.
1467
1468 =item check_freq
1469
1470 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1471
1472 =item stage
1473
1474 "collect" (the default) or "pre-bill"
1475
1476 =item quiet
1477  
1478 set true to surpress email card/ACH decline notices.
1479
1480 =item debug
1481
1482 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
1483
1484 =back
1485 =cut
1486
1487 # =item payby
1488 #
1489 # allows for one time override of normal customer billing method
1490
1491 # =item retry
1492 #
1493 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1494
1495 sub do_cust_event {
1496   my( $self, %options ) = @_;
1497
1498   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1499
1500   my $time = $options{'time'} || time;
1501
1502   #put below somehow?
1503   local $SIG{HUP} = 'IGNORE';
1504   local $SIG{INT} = 'IGNORE';
1505   local $SIG{QUIT} = 'IGNORE';
1506   local $SIG{TERM} = 'IGNORE';
1507   local $SIG{TSTP} = 'IGNORE';
1508   local $SIG{PIPE} = 'IGNORE';
1509
1510   my $oldAutoCommit = $FS::UID::AutoCommit;
1511   local $FS::UID::AutoCommit = 0;
1512   my $dbh = dbh;
1513
1514   $self->select_for_update; #mutex
1515
1516   if ( $DEBUG ) {
1517     my $balance = $self->balance;
1518     warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
1519   }
1520
1521 #  if ( exists($options{'retry_card'}) ) {
1522 #    carp 'retry_card option passed to collect is deprecated; use retry';
1523 #    $options{'retry'} ||= $options{'retry_card'};
1524 #  }
1525 #  if ( exists($options{'retry'}) && $options{'retry'} ) {
1526 #    my $error = $self->retry_realtime;
1527 #    if ( $error ) {
1528 #      $dbh->rollback if $oldAutoCommit;
1529 #      return $error;
1530 #    }
1531 #  }
1532
1533   # false laziness w/pay_batch::import_results
1534
1535   my $due_cust_event = $self->due_cust_event(
1536     'debug'      => ( $options{'debug'} || 0 ),
1537     'time'       => $time,
1538     'check_freq' => $options{'check_freq'},
1539     'stage'      => ( $options{'stage'} || 'collect' ),
1540   );
1541   unless( ref($due_cust_event) ) {
1542     $dbh->rollback if $oldAutoCommit;
1543     return $due_cust_event;
1544   }
1545
1546   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1547   #never want to roll back an event just because it or a different one
1548   # returned an error
1549   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1550
1551   foreach my $cust_event ( @$due_cust_event ) {
1552
1553     #XXX lock event
1554     
1555     #re-eval event conditions (a previous event could have changed things)
1556     unless ( $cust_event->test_conditions( 'time' => $time ) ) {
1557       #don't leave stray "new/locked" records around
1558       my $error = $cust_event->delete;
1559       return $error if $error;
1560       next;
1561     }
1562
1563     {
1564       local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
1565         if $options{'quiet'};
1566       warn "  running cust_event ". $cust_event->eventnum. "\n"
1567         if $DEBUG > 1;
1568
1569       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
1570       if ( my $error = $cust_event->do_event() ) {
1571         #XXX wtf is this?  figure out a proper dealio with return value
1572         #from do_event
1573         return $error;
1574       }
1575     }
1576
1577   }
1578
1579   '';
1580
1581 }
1582
1583 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
1584
1585 Inserts database records for and returns an ordered listref of new events due
1586 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
1587 events are due, an empty listref is returned.  If there is an error, returns a
1588 scalar error message.
1589
1590 To actually run the events, call each event's test_condition method, and if
1591 still true, call the event's do_event method.
1592
1593 Options are passed as a hashref or as a list of name-value pairs.  Available
1594 options are:
1595
1596 =over 4
1597
1598 =item check_freq
1599
1600 Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
1601
1602 =item stage
1603
1604 "collect" (the default) or "pre-bill"
1605
1606 =item time
1607
1608 "Current time" for the events.
1609
1610 =item debug
1611
1612 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
1613
1614 =item eventtable
1615
1616 Only return events for the specified eventtable (by default, events of all eventtables are returned)
1617
1618 =item objects
1619
1620 Explicitly pass the objects to be tested (typically used with eventtable).
1621
1622 =item testonly
1623
1624 Set to true to return the objects, but not actually insert them into the
1625 database.
1626
1627 =item discount_terms
1628
1629 Returns a list of lengths for term discounts
1630
1631 =cut
1632
1633 sub _discount_pkgs_and_bill {
1634 my $self = shift;
1635
1636   my @cust_bill = $self->cust_bill;
1637   my $cust_bill = pop @cust_bill;
1638   return () unless $cust_bill && $cust_bill->owed;
1639
1640   my @where = ();
1641   push @where, "cust_bill_pkg.invnum = ". $cust_bill->invnum;
1642   push @where, "cust_bill_pkg.pkgpart_override IS NULL";
1643   push @where, "part_pkg.freq = '1'";
1644   push @where, "(cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0)";
1645   push @where, "(cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0)";
1646   push @where, "0<(SELECT count(*) FROM part_pkg_discount
1647                   WHERE part_pkg.pkgpart = part_pkg_discount.pkgpart)";
1648   push @where,
1649     "0=(SELECT count(*) FROM cust_bill_pkg_discount
1650          WHERE cust_bill_pkg.billpkgnum = cust_bill_pkg_discount.billpkgnum)";
1651
1652   my $extra_sql = 'WHERE '. join(' AND ', @where);
1653
1654   my @cust_pkg = 
1655     qsearch({
1656       'table' => 'cust_pkg',
1657       'select' => "DISTINCT cust_pkg.*",
1658       'addl_from' => 'JOIN cust_bill_pkg USING(pkgnum) '.
1659                      'JOIN part_pkg USING(pkgpart)',
1660       'hashref' => {},
1661       'extra_sql' => $extra_sql,
1662     }); 
1663
1664   ($cust_bill, @cust_pkg);
1665 }
1666
1667 sub _discountable_pkgs_at_term {
1668   my ($term, @pkgs) = @_;
1669   my $part_pkg = new FS::part_pkg { freq => $term - 1 };
1670   grep { ( !$_->adjourn || $_->adjourn > $part_pkg->add_freq($_->bill) ) && 
1671          ( !$_->expire  || $_->expire  > $part_pkg->add_freq($_->bill) )
1672        }
1673     @pkgs;
1674 }
1675
1676 =item discount_terms
1677
1678 Returns a list of lengths for term discounts
1679
1680 =cut
1681
1682 sub discount_terms {
1683 my $self = shift;
1684
1685   my %terms = ();
1686
1687   my @discount_pkgs = $self->_discount_pkgs_and_bill;
1688   shift @discount_pkgs; #discard bill;
1689   
1690   map { $terms{$_->months} = 1 }
1691     grep { $_->months && $_->months > 1 }
1692     map { $_->discount }
1693     map { $_->part_pkg->part_pkg_discount }
1694     @discount_pkgs;
1695
1696   return sort { $a <=> $b } keys %terms;
1697
1698 }
1699
1700 =back
1701
1702 =item discount_term_values MONTHS
1703
1704 Returns a list with credit, dollar amount saved, and total bill acheived
1705 by prepaying the most recent invoice for MONTHS.
1706
1707 =cut
1708
1709 sub discount_term_values {
1710   my $self = shift;
1711   my $term = shift;
1712
1713   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1714
1715   warn "$me discount_term_values called with $term\n" if $DEBUG;
1716
1717   my %result = ();
1718
1719   my @packages = $self->_discount_pkgs_and_bill;
1720   my $cust_bill = shift(@packages);
1721   @packages = _discountable_pkgs_at_term( $term, @packages );
1722   return () unless scalar(@packages);
1723
1724   $_->bill($_->last_bill) foreach @packages;
1725   my @final = map { new FS::cust_pkg { $_->hash } } @packages;
1726
1727   my %options = (
1728                   'recurring_only' => 1,
1729                   'no_usage_reset' => 1,
1730                   'no_commit'      => 1,
1731                 );
1732
1733   my %params =  (
1734                   'return_bill'    => [],
1735                   'pkg_list'       => \@packages,
1736                   'time'           => $cust_bill->_date,
1737                 );
1738
1739   my $error = $self->bill(%options, %params);
1740   die $error if $error; # XXX think about this a bit more
1741
1742   my $credit = 0;
1743   $credit += $_->charged foreach @{$params{return_bill}};
1744   $credit = sprintf('%.2f', $credit);
1745   warn "$me discount_term_values $term credit: $credit\n" if $DEBUG;
1746
1747   %params =  (
1748                'return_bill'    => [],
1749                'pkg_list'       => \@packages,
1750                'time'           => $packages[0]->part_pkg->add_freq($cust_bill->_date)
1751              );
1752
1753   $error = $self->bill(%options, %params);
1754   die $error if $error; # XXX think about this a bit more
1755
1756   my $next = 0;
1757   $next += $_->charged foreach @{$params{return_bill}};
1758   warn "$me discount_term_values $term next: $next\n" if $DEBUG;
1759   
1760   %params =  ( 
1761                'return_bill'    => [],
1762                'pkg_list'       => \@final,
1763                'time'           => $cust_bill->_date,
1764                'freq_override'  => $term,
1765              );
1766
1767   $error = $self->bill(%options, %params);
1768   die $error if $error; # XXX think about this a bit more
1769
1770   my $final = $self->balance - $credit;
1771   $final += $_->charged foreach @{$params{return_bill}};
1772   $final = sprintf('%.2f', $final);
1773   warn "$me discount_term_values $term final: $final\n" if $DEBUG;
1774
1775   my $savings = sprintf('%.2f', $self->balance + ($term - 1) * $next - $final);
1776
1777   ( $credit, $savings, $final );
1778
1779 }
1780
1781 sub discount_terms_hash {
1782   my $self = shift;
1783
1784   my %result = ();
1785   my @terms = $self->discount_terms;
1786   foreach my $term (@terms) {
1787     my @result = $self->discount_term_values($term);
1788     $result{$term} = [ @result ] if scalar(@result);
1789   }
1790
1791   return %result;
1792
1793 }
1794
1795 =back
1796
1797 =cut
1798
1799 sub due_cust_event {
1800   my $self = shift;
1801   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
1802
1803   #???
1804   #my $DEBUG = $opt{'debug'}
1805   local($DEBUG) = $opt{'debug'}
1806     if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
1807   $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1808
1809   warn "$me due_cust_event called with options ".
1810        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
1811     if $DEBUG;
1812
1813   $opt{'time'} ||= time;
1814
1815   local $SIG{HUP} = 'IGNORE';
1816   local $SIG{INT} = 'IGNORE';
1817   local $SIG{QUIT} = 'IGNORE';
1818   local $SIG{TERM} = 'IGNORE';
1819   local $SIG{TSTP} = 'IGNORE';
1820   local $SIG{PIPE} = 'IGNORE';
1821
1822   my $oldAutoCommit = $FS::UID::AutoCommit;
1823   local $FS::UID::AutoCommit = 0;
1824   my $dbh = dbh;
1825
1826   $self->select_for_update #mutex
1827     unless $opt{testonly};
1828
1829   ###
1830   # find possible events (initial search)
1831   ###
1832   
1833   my @cust_event = ();
1834
1835   my @eventtable = $opt{'eventtable'}
1836                      ? ( $opt{'eventtable'} )
1837                      : FS::part_event->eventtables_runorder;
1838
1839   my $check_freq = $opt{'check_freq'} || '1d';
1840
1841   foreach my $eventtable ( @eventtable ) {
1842
1843     my @objects;
1844     if ( $opt{'objects'} ) {
1845
1846       @objects = @{ $opt{'objects'} };
1847
1848     } else {
1849
1850       #my @objects = $self->$eventtable(); # sub cust_main { @{ [ $self ] }; }
1851       if ( $eventtable eq 'cust_main' ) {
1852         @objects = ( $self );
1853       } else {
1854
1855         my $cm_join =
1856           "LEFT JOIN cust_main USING ( custnum )";
1857
1858         #some false laziness w/Cron::bill bill_where
1859
1860         my $join  = FS::part_event_condition->join_conditions_sql( $eventtable);
1861         my $where = FS::part_event_condition->where_conditions_sql($eventtable,
1862                                                            'time'=>$opt{'time'},
1863                                                                   );
1864         $where = $where ? "AND $where" : '';
1865
1866         my $are_part_event = 
1867           "EXISTS ( SELECT 1 FROM part_event $join
1868                       WHERE check_freq = '$check_freq'
1869                         AND eventtable = '$eventtable'
1870                         AND ( disabled = '' OR disabled IS NULL )
1871                         $where
1872                   )
1873           ";
1874         #eofalse
1875
1876         @objects = $self->$eventtable(
1877                      'addl_from' => $cm_join,
1878                      'extra_sql' => " AND $are_part_event",
1879                    );
1880       }
1881
1882     }
1883
1884     my @e_cust_event = ();
1885
1886     my $cross = "CROSS JOIN $eventtable";
1887     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
1888       unless $eventtable eq 'cust_main';
1889
1890     foreach my $object ( @objects ) {
1891
1892       #this first search uses the condition_sql magic for optimization.
1893       #the more possible events we can eliminate in this step the better
1894
1895       my $cross_where = '';
1896       my $pkey = $object->primary_key;
1897       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
1898
1899       my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
1900       my $extra_sql =
1901         FS::part_event_condition->where_conditions_sql( $eventtable,
1902                                                         'time'=>$opt{'time'}
1903                                                       );
1904       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
1905
1906       $extra_sql = "AND $extra_sql" if $extra_sql;
1907
1908       #here is the agent virtualization
1909       $extra_sql .= " AND (    part_event.agentnum IS NULL
1910                             OR part_event.agentnum = ". $self->agentnum. ' )';
1911
1912       $extra_sql .= " $order";
1913
1914       warn "searching for events for $eventtable ". $object->$pkey. "\n"
1915         if $opt{'debug'} > 2;
1916       my @part_event = qsearch( {
1917         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
1918         'select'    => 'part_event.*',
1919         'table'     => 'part_event',
1920         'addl_from' => "$cross $join",
1921         'hashref'   => { 'check_freq' => $check_freq,
1922                          'eventtable' => $eventtable,
1923                          'disabled'   => '',
1924                        },
1925         'extra_sql' => "AND $cross_where $extra_sql",
1926       } );
1927
1928       if ( $DEBUG > 2 ) {
1929         my $pkey = $object->primary_key;
1930         warn "      ". scalar(@part_event).
1931              " possible events found for $eventtable ". $object->$pkey(). "\n";
1932       }
1933
1934       push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
1935
1936     }
1937
1938     warn "    ". scalar(@e_cust_event).
1939          " subtotal possible cust events found for $eventtable\n"
1940       if $DEBUG > 1;
1941
1942     push @cust_event, @e_cust_event;
1943
1944   }
1945
1946   warn "  ". scalar(@cust_event).
1947        " total possible cust events found in initial search\n"
1948     if $DEBUG; # > 1;
1949
1950
1951   ##
1952   # test stage
1953   ##
1954
1955   $opt{stage} ||= 'collect';
1956   @cust_event =
1957     grep { my $stage = $_->part_event->event_stage;
1958            $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
1959          }
1960          @cust_event;
1961
1962   ##
1963   # test conditions
1964   ##
1965   
1966   my %unsat = ();
1967
1968   @cust_event = grep $_->test_conditions( 'time'          => $opt{'time'},
1969                                           'stats_hashref' => \%unsat ),
1970                      @cust_event;
1971
1972   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
1973     if $DEBUG; # > 1;
1974
1975   warn "    invalid conditions not eliminated with condition_sql:\n".
1976        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
1977     if keys %unsat && $DEBUG; # > 1;
1978
1979   ##
1980   # insert
1981   ##
1982
1983   unless( $opt{testonly} ) {
1984     foreach my $cust_event ( @cust_event ) {
1985
1986       my $error = $cust_event->insert();
1987       if ( $error ) {
1988         $dbh->rollback if $oldAutoCommit;
1989         return $error;
1990       }
1991                                        
1992     }
1993   }
1994
1995   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1996
1997   ##
1998   # return
1999   ##
2000
2001   warn "  returning events: ". Dumper(@cust_event). "\n"
2002     if $DEBUG > 2;
2003
2004   \@cust_event;
2005
2006 }
2007
2008 =item apply_payments_and_credits [ OPTION => VALUE ... ]
2009
2010 Applies unapplied payments and credits.
2011
2012 In most cases, this new method should be used in place of sequential
2013 apply_payments and apply_credits methods.
2014
2015 A hash of optional arguments may be passed.  Currently "manual" is supported.
2016 If true, a payment receipt is sent instead of a statement when
2017 'payment_receipt_email' configuration option is set.
2018
2019 If there is an error, returns the error, otherwise returns false.
2020
2021 =cut
2022
2023 sub apply_payments_and_credits {
2024   my( $self, %options ) = @_;
2025
2026   local $SIG{HUP} = 'IGNORE';
2027   local $SIG{INT} = 'IGNORE';
2028   local $SIG{QUIT} = 'IGNORE';
2029   local $SIG{TERM} = 'IGNORE';
2030   local $SIG{TSTP} = 'IGNORE';
2031   local $SIG{PIPE} = 'IGNORE';
2032
2033   my $oldAutoCommit = $FS::UID::AutoCommit;
2034   local $FS::UID::AutoCommit = 0;
2035   my $dbh = dbh;
2036
2037   $self->select_for_update; #mutex
2038
2039   foreach my $cust_bill ( $self->open_cust_bill ) {
2040     my $error = $cust_bill->apply_payments_and_credits(%options);
2041     if ( $error ) {
2042       $dbh->rollback if $oldAutoCommit;
2043       return "Error applying: $error";
2044     }
2045   }
2046
2047   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2048   ''; #no error
2049
2050 }
2051
2052 =item apply_credits OPTION => VALUE ...
2053
2054 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2055 to outstanding invoice balances in chronological order (or reverse
2056 chronological order if the I<order> option is set to B<newest>) and returns the
2057 value of any remaining unapplied credits available for refund (see
2058 L<FS::cust_refund>).
2059
2060 Dies if there is an error.
2061
2062 =cut
2063
2064 sub apply_credits {
2065   my $self = shift;
2066   my %opt = @_;
2067
2068   local $SIG{HUP} = 'IGNORE';
2069   local $SIG{INT} = 'IGNORE';
2070   local $SIG{QUIT} = 'IGNORE';
2071   local $SIG{TERM} = 'IGNORE';
2072   local $SIG{TSTP} = 'IGNORE';
2073   local $SIG{PIPE} = 'IGNORE';
2074
2075   my $oldAutoCommit = $FS::UID::AutoCommit;
2076   local $FS::UID::AutoCommit = 0;
2077   my $dbh = dbh;
2078
2079   $self->select_for_update; #mutex
2080
2081   unless ( $self->total_unapplied_credits ) {
2082     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2083     return 0;
2084   }
2085
2086   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2087       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2088
2089   my @invoices = $self->open_cust_bill;
2090   @invoices = sort { $b->_date <=> $a->_date } @invoices
2091     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2092
2093   if ( $conf->exists('pkg-balances') ) {
2094     # limit @credits to those w/ a pkgnum grepped from $self
2095     my %pkgnums = ();
2096     foreach my $i (@invoices) {
2097       foreach my $li ( $i->cust_bill_pkg ) {
2098         $pkgnums{$li->pkgnum} = 1;
2099       }
2100     }
2101     @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2102   }
2103
2104   my $credit;
2105
2106   foreach my $cust_bill ( @invoices ) {
2107
2108     if ( !defined($credit) || $credit->credited == 0) {
2109       $credit = pop @credits or last;
2110     }
2111
2112     my $owed;
2113     if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2114       $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2115     } else {
2116       $owed = $cust_bill->owed;
2117     }
2118     unless ( $owed > 0 ) {
2119       push @credits, $credit;
2120       next;
2121     }
2122
2123     my $amount = min( $credit->credited, $owed );
2124     
2125     my $cust_credit_bill = new FS::cust_credit_bill ( {
2126       'crednum' => $credit->crednum,
2127       'invnum'  => $cust_bill->invnum,
2128       'amount'  => $amount,
2129     } );
2130     $cust_credit_bill->pkgnum( $credit->pkgnum )
2131       if $conf->exists('pkg-balances') && $credit->pkgnum;
2132     my $error = $cust_credit_bill->insert;
2133     if ( $error ) {
2134       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2135       die $error;
2136     }
2137     
2138     redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2139
2140   }
2141
2142   my $total_unapplied_credits = $self->total_unapplied_credits;
2143
2144   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2145
2146   return $total_unapplied_credits;
2147 }
2148
2149 =item apply_payments  [ OPTION => VALUE ... ]
2150
2151 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2152 to outstanding invoice balances in chronological order.
2153
2154  #and returns the value of any remaining unapplied payments.
2155
2156 A hash of optional arguments may be passed.  Currently "manual" is supported.
2157 If true, a payment receipt is sent instead of a statement when
2158 'payment_receipt_email' configuration option is set.
2159
2160 Dies if there is an error.
2161
2162 =cut
2163
2164 sub apply_payments {
2165   my( $self, %options ) = @_;
2166
2167   local $SIG{HUP} = 'IGNORE';
2168   local $SIG{INT} = 'IGNORE';
2169   local $SIG{QUIT} = 'IGNORE';
2170   local $SIG{TERM} = 'IGNORE';
2171   local $SIG{TSTP} = 'IGNORE';
2172   local $SIG{PIPE} = 'IGNORE';
2173
2174   my $oldAutoCommit = $FS::UID::AutoCommit;
2175   local $FS::UID::AutoCommit = 0;
2176   my $dbh = dbh;
2177
2178   $self->select_for_update; #mutex
2179
2180   #return 0 unless
2181
2182   my @payments = sort { $b->_date <=> $a->_date }
2183                  grep { $_->unapplied > 0 }
2184                  $self->cust_pay;
2185
2186   my @invoices = sort { $a->_date <=> $b->_date}
2187                  grep { $_->owed > 0 }
2188                  $self->cust_bill;
2189
2190   if ( $conf->exists('pkg-balances') ) {
2191     # limit @payments to those w/ a pkgnum grepped from $self
2192     my %pkgnums = ();
2193     foreach my $i (@invoices) {
2194       foreach my $li ( $i->cust_bill_pkg ) {
2195         $pkgnums{$li->pkgnum} = 1;
2196       }
2197     }
2198     @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2199   }
2200
2201   my $payment;
2202
2203   foreach my $cust_bill ( @invoices ) {
2204
2205     if ( !defined($payment) || $payment->unapplied == 0 ) {
2206       $payment = pop @payments or last;
2207     }
2208
2209     my $owed;
2210     if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2211       $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2212     } else {
2213       $owed = $cust_bill->owed;
2214     }
2215     unless ( $owed > 0 ) {
2216       push @payments, $payment;
2217       next;
2218     }
2219
2220     my $amount = min( $payment->unapplied, $owed );
2221
2222     my $cust_bill_pay = new FS::cust_bill_pay ( {
2223       'paynum' => $payment->paynum,
2224       'invnum' => $cust_bill->invnum,
2225       'amount' => $amount,
2226     } );
2227     $cust_bill_pay->pkgnum( $payment->pkgnum )
2228       if $conf->exists('pkg-balances') && $payment->pkgnum;
2229     my $error = $cust_bill_pay->insert(%options);
2230     if ( $error ) {
2231       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2232       die $error;
2233     }
2234
2235     redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2236
2237   }
2238
2239   my $total_unapplied_payments = $self->total_unapplied_payments;
2240
2241   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2242
2243   return $total_unapplied_payments;
2244 }
2245
2246 =head1 BUGS
2247
2248 =head1 SEE ALSO
2249
2250 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>
2251
2252 =cut
2253
2254 1;