fix (part of) 3.x performance regression on customers with tons of invoices, RT#29646...
[freeside.git] / FS / FS / cust_bill_pkg.pm
1 package FS::cust_bill_pkg;
2 use base qw( FS::TemplateItem_Mixin FS::cust_main_Mixin FS::Record );
3
4 use strict;
5 use vars qw( @ISA $DEBUG $me );
6 use Carp;
7 use List::Util qw( sum min );
8 use Text::CSV_XS;
9 use FS::Record qw( qsearch qsearchs dbh );
10 use FS::cust_pkg;
11 use FS::cust_bill_pkg_detail;
12 use FS::cust_bill_pkg_display;
13 use FS::cust_bill_pkg_discount;
14 use FS::cust_bill_pkg_fee;
15 use FS::cust_bill_pay_pkg;
16 use FS::cust_credit_bill_pkg;
17 use FS::cust_tax_exempt_pkg;
18 use FS::cust_bill_pkg_tax_location;
19 use FS::cust_bill_pkg_tax_rate_location;
20 use FS::cust_tax_adjustment;
21 use FS::cust_bill_pkg_void;
22 use FS::cust_bill_pkg_detail_void;
23 use FS::cust_bill_pkg_display_void;
24 use FS::cust_bill_pkg_discount_void;
25 use FS::cust_bill_pkg_tax_location_void;
26 use FS::cust_bill_pkg_tax_rate_location_void;
27 use FS::cust_tax_exempt_pkg_void;
28
29 use FS::Cursor;
30
31 $DEBUG = 0;
32 $me = '[FS::cust_bill_pkg]';
33
34 =head1 NAME
35
36 FS::cust_bill_pkg - Object methods for cust_bill_pkg records
37
38 =head1 SYNOPSIS
39
40   use FS::cust_bill_pkg;
41
42   $record = new FS::cust_bill_pkg \%hash;
43   $record = new FS::cust_bill_pkg { 'column' => 'value' };
44
45   $error = $record->insert;
46
47   $error = $record->check;
48
49 =head1 DESCRIPTION
50
51 An FS::cust_bill_pkg object represents an invoice line item.
52 FS::cust_bill_pkg inherits from FS::Record.  The following fields are
53 currently supported:
54
55 =over 4
56
57 =item billpkgnum
58
59 primary key
60
61 =item invnum
62
63 invoice (see L<FS::cust_bill>)
64
65 =item pkgnum
66
67 package (see L<FS::cust_pkg>) or 0 for the special virtual sales tax package, or -1 for the virtual line item (itemdesc is used for the line)
68
69 =item pkgpart_override
70
71 optional package definition (see L<FS::part_pkg>) override
72
73 =item setup
74
75 setup fee
76
77 =item recur
78
79 recurring fee
80
81 =item sdate
82
83 starting date of recurring fee
84
85 =item edate
86
87 ending date of recurring fee
88
89 =item itemdesc
90
91 Line item description (overrides normal package description)
92
93 =item quantity
94
95 If not set, defaults to 1
96
97 =item unitsetup
98
99 If not set, defaults to setup
100
101 =item unitrecur
102
103 If not set, defaults to recur
104
105 =item hidden
106
107 If set to Y, indicates data should not appear as separate line item on invoice
108
109 =back
110
111 sdate and edate are specified as UNIX timestamps; see L<perlfunc/"time">.  Also
112 see L<Time::Local> and L<Date::Parse> for conversion functions.
113
114 =head1 METHODS
115
116 =over 4
117
118 =item new HASHREF
119
120 Creates a new line item.  To add the line item to the database, see
121 L<"insert">.  Line items are normally created by calling the bill method of a
122 customer object (see L<FS::cust_main>).
123
124 =cut
125
126 sub table { 'cust_bill_pkg'; }
127
128 sub detail_table            { 'cust_bill_pkg_detail'; }
129 sub display_table           { 'cust_bill_pkg_display'; }
130 sub discount_table          { 'cust_bill_pkg_discount'; }
131 #sub tax_location_table      { 'cust_bill_pkg_tax_location'; }
132 #sub tax_rate_location_table { 'cust_bill_pkg_tax_rate_location'; }
133 #sub tax_exempt_pkg_table    { 'cust_tax_exempt_pkg'; }
134
135 =item insert
136
137 Adds this line item to the database.  If there is an error, returns the error,
138 otherwise returns false.
139
140 =cut
141
142 sub insert {
143   my $self = shift;
144
145   local $SIG{HUP} = 'IGNORE';
146   local $SIG{INT} = 'IGNORE';
147   local $SIG{QUIT} = 'IGNORE';
148   local $SIG{TERM} = 'IGNORE';
149   local $SIG{TSTP} = 'IGNORE';
150   local $SIG{PIPE} = 'IGNORE';
151
152   my $oldAutoCommit = $FS::UID::AutoCommit;
153   local $FS::UID::AutoCommit = 0;
154   my $dbh = dbh;
155
156   my $error = $self->SUPER::insert;
157   if ( $error ) {
158     $dbh->rollback if $oldAutoCommit;
159     return $error;
160   }
161
162   if ( $self->get('details') ) {
163     foreach my $detail ( @{$self->get('details')} ) {
164       $detail->billpkgnum($self->billpkgnum);
165       $error = $detail->insert;
166       if ( $error ) {
167         $dbh->rollback if $oldAutoCommit;
168         return "error inserting cust_bill_pkg_detail: $error";
169       }
170     }
171   }
172
173   if ( $self->get('display') ) {
174     foreach my $cust_bill_pkg_display ( @{ $self->get('display') } ) {
175       $cust_bill_pkg_display->billpkgnum($self->billpkgnum);
176       $error = $cust_bill_pkg_display->insert;
177       if ( $error ) {
178         $dbh->rollback if $oldAutoCommit;
179         return "error inserting cust_bill_pkg_display: $error";
180       }
181     }
182   }
183
184   if ( $self->get('discounts') ) {
185     foreach my $cust_bill_pkg_discount ( @{$self->get('discounts')} ) {
186       $cust_bill_pkg_discount->billpkgnum($self->billpkgnum);
187       $error = $cust_bill_pkg_discount->insert;
188       if ( $error ) {
189         $dbh->rollback if $oldAutoCommit;
190         return "error inserting cust_bill_pkg_discount: $error";
191       }
192     }
193   }
194
195   foreach my $cust_tax_exempt_pkg ( @{$self->cust_tax_exempt_pkg} ) {
196     $cust_tax_exempt_pkg->billpkgnum($self->billpkgnum);
197     $error = $cust_tax_exempt_pkg->insert;
198     if ( $error ) {
199       $dbh->rollback if $oldAutoCommit;
200       return "error inserting cust_tax_exempt_pkg: $error";
201     }
202   }
203
204   my $tax_location = $self->get('cust_bill_pkg_tax_location');
205   if ( $tax_location ) {
206     foreach my $link ( @$tax_location ) {
207       next if $link->billpkgtaxlocationnum; # don't try to double-insert
208       # This cust_bill_pkg can be linked on either side (i.e. it can be the
209       # tax or the taxed item).  If the other side is already inserted, 
210       # then set billpkgnum to ours, and insert the link.  Otherwise,
211       # set billpkgnum to ours and pass the link off to the cust_bill_pkg
212       # on the other side, to be inserted later.
213
214       my $tax_cust_bill_pkg = $link->get('tax_cust_bill_pkg');
215       if ( $tax_cust_bill_pkg && $tax_cust_bill_pkg->billpkgnum ) {
216         $link->set('billpkgnum', $tax_cust_bill_pkg->billpkgnum);
217         # break circular links when doing this
218         $link->set('tax_cust_bill_pkg', '');
219       }
220       my $taxable_cust_bill_pkg = $link->get('taxable_cust_bill_pkg');
221       if ( $taxable_cust_bill_pkg && $taxable_cust_bill_pkg->billpkgnum ) {
222         $link->set('taxable_billpkgnum', $taxable_cust_bill_pkg->billpkgnum);
223         # XXX if we ever do tax-on-tax for these, this will have to change
224         # since pkgnum will be zero
225         $link->set('pkgnum', $taxable_cust_bill_pkg->pkgnum);
226         $link->set('locationnum', $taxable_cust_bill_pkg->tax_locationnum);
227         $link->set('taxable_cust_bill_pkg', '');
228       }
229
230       if ( $link->billpkgnum and $link->taxable_billpkgnum ) {
231         $error = $link->insert;
232         if ( $error ) {
233           $dbh->rollback if $oldAutoCommit;
234           return "error inserting cust_bill_pkg_tax_location: $error";
235         }
236       } else { # handoff
237         my $other;
238         $other = $link->billpkgnum ? $link->get('taxable_cust_bill_pkg')
239                                    : $link->get('tax_cust_bill_pkg');
240         my $link_array = $other->get('cust_bill_pkg_tax_location') || [];
241         push @$link_array, $link;
242         $other->set('cust_bill_pkg_tax_location' => $link_array);
243       }
244     } #foreach my $link
245   }
246
247   # someday you will be as awesome as cust_bill_pkg_tax_location...
248   # but not today
249   my $tax_rate_location = $self->get('cust_bill_pkg_tax_rate_location');
250   if ( $tax_rate_location ) {
251     foreach my $cust_bill_pkg_tax_rate_location ( @$tax_rate_location ) {
252       $cust_bill_pkg_tax_rate_location->billpkgnum($self->billpkgnum);
253       $error = $cust_bill_pkg_tax_rate_location->insert;
254       if ( $error ) {
255         $dbh->rollback if $oldAutoCommit;
256         return "error inserting cust_bill_pkg_tax_rate_location: $error";
257       }
258     }
259   }
260
261   my $fee_links = $self->get('cust_bill_pkg_fee');
262   if ( $fee_links ) {
263     foreach my $link ( @$fee_links ) {
264       # very similar to cust_bill_pkg_tax_location, for obvious reasons
265       next if $link->billpkgfeenum; # don't try to double-insert
266
267       my $target = $link->get('cust_bill_pkg'); # the line item of the fee
268       my $base = $link->get('base_cust_bill_pkg'); # line item it was based on
269
270       if ( $target and $target->billpkgnum ) {
271         $link->set('billpkgnum', $target->billpkgnum);
272         # base_invnum => null indicates that the fee is based on its own
273         # invoice
274         $link->set('base_invnum', $target->invnum) unless $link->base_invnum;
275         $link->set('cust_bill_pkg', '');
276       }
277
278       if ( $base and $base->billpkgnum ) {
279         $link->set('base_billpkgnum', $base->billpkgnum);
280         $link->set('base_cust_bill_pkg', '');
281       } elsif ( $base ) {
282         # it's based on a line item that's not yet inserted
283         my $link_array = $base->get('cust_bill_pkg_fee') || [];
284         push @$link_array, $link;
285         $base->set('cust_bill_pkg_fee' => $link_array);
286         next; # don't insert the link yet
287       }
288
289       $error = $link->insert;
290       if ( $error ) {
291         $dbh->rollback if $oldAutoCommit;
292         return "error inserting cust_bill_pkg_fee: $error";
293       }
294     } # foreach my $link
295   }
296
297   my $cust_event_fee = $self->get('cust_event_fee');
298   if ( $cust_event_fee ) {
299     $cust_event_fee->set('billpkgnum' => $self->billpkgnum);
300     $error = $cust_event_fee->replace;
301     if ( $error ) {
302       $dbh->rollback if $oldAutoCommit;
303       return "error updating cust_event_fee: $error";
304     }
305   }
306
307   my $cust_tax_adjustment = $self->get('cust_tax_adjustment');
308   if ( $cust_tax_adjustment ) {
309     $cust_tax_adjustment->billpkgnum($self->billpkgnum);
310     $error = $cust_tax_adjustment->replace;
311     if ( $error ) {
312       $dbh->rollback if $oldAutoCommit;
313       return "error replacing cust_tax_adjustment: $error";
314     }
315   }
316
317   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
318   '';
319
320 }
321
322 =item void
323
324 Voids this line item: deletes the line item and adds a record of the voided
325 line item to the FS::cust_bill_pkg_void table (and related tables).
326
327 =cut
328
329 sub void {
330   my $self = shift;
331   my $reason = scalar(@_) ? shift : '';
332
333   local $SIG{HUP} = 'IGNORE';
334   local $SIG{INT} = 'IGNORE';
335   local $SIG{QUIT} = 'IGNORE';
336   local $SIG{TERM} = 'IGNORE';
337   local $SIG{TSTP} = 'IGNORE';
338   local $SIG{PIPE} = 'IGNORE';
339
340   my $oldAutoCommit = $FS::UID::AutoCommit;
341   local $FS::UID::AutoCommit = 0;
342   my $dbh = dbh;
343
344   my $cust_bill_pkg_void = new FS::cust_bill_pkg_void ( {
345     map { $_ => $self->get($_) } $self->fields
346   } );
347   $cust_bill_pkg_void->reason($reason);
348   my $error = $cust_bill_pkg_void->insert;
349   if ( $error ) {
350     $dbh->rollback if $oldAutoCommit;
351     return $error;
352   }
353
354   foreach my $table (qw(
355     cust_bill_pkg_detail
356     cust_bill_pkg_display
357     cust_bill_pkg_discount
358     cust_bill_pkg_tax_location
359     cust_bill_pkg_tax_rate_location
360     cust_tax_exempt_pkg
361   )) {
362
363     foreach my $linked ( qsearch($table, { billpkgnum=>$self->billpkgnum }) ) {
364
365       my $vclass = 'FS::'.$table.'_void';
366       my $void = $vclass->new( {
367         map { $_ => $linked->get($_) } $linked->fields
368       });
369       my $error = $void->insert || $linked->delete;
370       if ( $error ) {
371         $dbh->rollback if $oldAutoCommit;
372         return $error;
373       }
374
375     }
376
377   }
378
379   $error = $self->delete;
380   if ( $error ) {
381     $dbh->rollback if $oldAutoCommit;
382     return $error;
383   }
384
385   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
386
387   '';
388
389 }
390
391 =item delete
392
393 Not recommended.
394
395 =cut
396
397 sub delete {
398   my $self = shift;
399
400   local $SIG{HUP} = 'IGNORE';
401   local $SIG{INT} = 'IGNORE';
402   local $SIG{QUIT} = 'IGNORE';
403   local $SIG{TERM} = 'IGNORE';
404   local $SIG{TSTP} = 'IGNORE';
405   local $SIG{PIPE} = 'IGNORE';
406
407   my $oldAutoCommit = $FS::UID::AutoCommit;
408   local $FS::UID::AutoCommit = 0;
409   my $dbh = dbh;
410
411   foreach my $table (qw(
412     cust_bill_pkg_detail
413     cust_bill_pkg_display
414     cust_bill_pkg_discount
415     cust_bill_pkg_tax_location
416     cust_bill_pkg_tax_rate_location
417     cust_tax_exempt_pkg
418     cust_bill_pay_pkg
419     cust_credit_bill_pkg
420   )) {
421
422     foreach my $linked ( qsearch($table, { billpkgnum=>$self->billpkgnum }) ) {
423       my $error = $linked->delete;
424       if ( $error ) {
425         $dbh->rollback if $oldAutoCommit;
426         return $error;
427       }
428     }
429
430   }
431
432   foreach my $cust_tax_adjustment (
433     qsearch('cust_tax_adjustment', { billpkgnum=>$self->billpkgnum })
434   ) {
435     $cust_tax_adjustment->billpkgnum(''); #NULL
436     my $error = $cust_tax_adjustment->replace;
437     if ( $error ) {
438       $dbh->rollback if $oldAutoCommit;
439       return $error;
440     }
441   }
442
443   my $error = $self->SUPER::delete(@_);
444   if ( $error ) {
445     $dbh->rollback if $oldAutoCommit;
446     return $error;
447   }
448
449   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
450
451   '';
452
453 }
454
455 #alas, bin/follow-tax-rename
456 #
457 #=item replace OLD_RECORD
458 #
459 #Currently unimplemented.  This would be even more of an accounting nightmare
460 #than deleteing the items.  Just don't do it.
461 #
462 #=cut
463 #
464 #sub replace {
465 #  return "Can't modify cust_bill_pkg records!";
466 #}
467
468 =item check
469
470 Checks all fields to make sure this is a valid line item.  If there is an
471 error, returns the error, otherwise returns false.  Called by the insert
472 method.
473
474 =cut
475
476 sub check {
477   my $self = shift;
478
479   my $error =
480          $self->ut_numbern('billpkgnum')
481       || $self->ut_snumber('pkgnum')
482       || $self->ut_number('invnum')
483       || $self->ut_money('setup')
484       || $self->ut_moneyn('unitsetup')
485       || $self->ut_currencyn('setup_billed_currency')
486       || $self->ut_moneyn('setup_billed_amount')
487       || $self->ut_money('recur')
488       || $self->ut_moneyn('unitrecur')
489       || $self->ut_currencyn('recur_billed_currency')
490       || $self->ut_moneyn('recur_billed_amount')
491       || $self->ut_numbern('sdate')
492       || $self->ut_numbern('edate')
493       || $self->ut_textn('itemdesc')
494       || $self->ut_textn('itemcomment')
495       || $self->ut_enum('hidden', [ '', 'Y' ])
496   ;
497   return $error if $error;
498
499   $self->regularize_details;
500
501   #if ( $self->pkgnum != 0 ) { #allow unchecked pkgnum 0 for tax! (add to part_pkg?)
502   if ( $self->pkgnum > 0 ) { #allow -1 for non-pkg line items and 0 for tax (add to part_pkg?)
503     return "Unknown pkgnum ". $self->pkgnum
504       unless qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
505   }
506
507   return "Unknown invnum"
508     unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } );
509
510   $self->SUPER::check;
511 }
512
513 =item regularize_details
514
515 Converts the contents of the 'details' pseudo-field to 
516 L<FS::cust_bill_pkg_detail> objects, if they aren't already.
517
518 =cut
519
520 sub regularize_details {
521   my $self = shift;
522   if ( $self->get('details') ) {
523     foreach my $detail ( @{$self->get('details')} ) {
524       if ( ref($detail) ne 'FS::cust_bill_pkg_detail' ) {
525         # then turn it into one
526         my %hash = ();
527         if ( ! ref($detail) ) {
528           $hash{'detail'} = $detail;
529         }
530         elsif ( ref($detail) eq 'HASH' ) {
531           %hash = %$detail;
532         }
533         elsif ( ref($detail) eq 'ARRAY' ) {
534           carp "passing invoice details as arrays is deprecated";
535           #carp "this way sucks, use a hash"; #but more useful/friendly
536           $hash{'format'}      = $detail->[0];
537           $hash{'detail'}      = $detail->[1];
538           $hash{'amount'}      = $detail->[2];
539           $hash{'classnum'}    = $detail->[3];
540           $hash{'phonenum'}    = $detail->[4];
541           $hash{'accountcode'} = $detail->[5];
542           $hash{'startdate'}   = $detail->[6];
543           $hash{'duration'}    = $detail->[7];
544           $hash{'regionname'}  = $detail->[8];
545         }
546         else {
547           die "unknown detail type ". ref($detail);
548         }
549         $detail = new FS::cust_bill_pkg_detail \%hash;
550       }
551       $detail->billpkgnum($self->billpkgnum) if $self->billpkgnum;
552     }
553   }
554   return;
555 }
556
557 =item cust_bill
558
559 Returns the invoice (see L<FS::cust_bill>) for this invoice line item.
560
561 =item cust_main
562
563 Returns the customer (L<FS::cust_main> object) for this line item.
564
565 =cut
566
567 sub cust_main {
568   # required for cust_main_Mixin equivalence
569   # and use cust_bill instead of cust_pkg because this might not have a 
570   # cust_pkg
571   my $self = shift;
572   my $cust_bill = $self->cust_bill or return '';
573   $cust_bill->cust_main;
574 }
575
576 =item previous_cust_bill_pkg
577
578 Returns the previous cust_bill_pkg for this package, if any.
579
580 =cut
581
582 sub previous_cust_bill_pkg {
583   my $self = shift;
584   return unless $self->sdate;
585   qsearchs({
586     'table'    => 'cust_bill_pkg',
587     'hashref'  => { 'pkgnum' => $self->pkgnum,
588                     'sdate'  => { op=>'<', value=>$self->sdate },
589                   },
590     'order_by' => 'ORDER BY sdate DESC LIMIT 1',
591   });
592 }
593
594 =item owed_setup
595
596 Returns the amount owed (still outstanding) on this line item's setup fee,
597 which is the amount of the line item minus all payment applications (see
598 L<FS::cust_bill_pay_pkg> and credit applications (see
599 L<FS::cust_credit_bill_pkg>).
600
601 =cut
602
603 sub owed_setup {
604   my $self = shift;
605   $self->owed('setup', @_);
606 }
607
608 =item owed_recur
609
610 Returns the amount owed (still outstanding) on this line item's recurring fee,
611 which is the amount of the line item minus all payment applications (see
612 L<FS::cust_bill_pay_pkg> and credit applications (see
613 L<FS::cust_credit_bill_pkg>).
614
615 =cut
616
617 sub owed_recur {
618   my $self = shift;
619   $self->owed('recur', @_);
620 }
621
622 # modeled after cust_bill::owed...
623 sub owed {
624   my( $self, $field ) = @_;
625   my $balance = $self->$field();
626   $balance -= $_->amount foreach ( $self->cust_bill_pay_pkg($field) );
627   $balance -= $_->amount foreach ( $self->cust_credit_bill_pkg($field) );
628   $balance = sprintf( '%.2f', $balance );
629   $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
630   $balance;
631 }
632
633 #modeled after owed
634 sub payable {
635   my( $self, $field ) = @_;
636   my $balance = $self->$field();
637   $balance -= $_->amount foreach ( $self->cust_credit_bill_pkg($field) );
638   $balance = sprintf( '%.2f', $balance );
639   $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
640   $balance;
641 }
642
643 sub cust_bill_pay_pkg {
644   my( $self, $field ) = @_;
645   qsearch( 'cust_bill_pay_pkg', { 'billpkgnum' => $self->billpkgnum,
646                                   'setuprecur' => $field,
647                                 }
648          );
649 }
650
651 sub cust_credit_bill_pkg {
652   my( $self, $field ) = @_;
653   qsearch( 'cust_credit_bill_pkg', { 'billpkgnum' => $self->billpkgnum,
654                                      'setuprecur' => $field,
655                                    }
656          );
657 }
658
659 =item units
660
661 Returns the number of billing units (for tax purposes) represented by this,
662 line item.
663
664 =cut
665
666 sub units {
667   my $self = shift;
668   $self->pkgnum ? $self->part_pkg->calc_units($self->cust_pkg) : 0; # 1?
669 }
670
671
672 =item set_display OPTION => VALUE ...
673
674 A helper method for I<insert>, populates the pseudo-field B<display> with
675 appropriate FS::cust_bill_pkg_display objects.
676
677 Options are passed as a list of name/value pairs.  Options are:
678
679 part_pkg: FS::part_pkg object from this line item's package.
680
681 real_pkgpart: if this line item comes from a bundled package, the pkgpart 
682 of the owning package.  Otherwise the same as the part_pkg's pkgpart above.
683
684 =cut
685
686 sub set_display {
687   my( $self, %opt ) = @_;
688   my $part_pkg = $opt{'part_pkg'};
689   my $cust_pkg = new FS::cust_pkg { pkgpart => $opt{real_pkgpart} };
690
691   my $conf = new FS::Conf;
692
693   # whether to break this down into setup/recur/usage
694   my $separate = $conf->exists('separate_usage');
695
696   my $usage_mandate =            $part_pkg->option('usage_mandate', 'Hush!')
697                     || $cust_pkg->part_pkg->option('usage_mandate', 'Hush!');
698
699   # or use the category from $opt{'part_pkg'} if its not bundled?
700   my $categoryname = $cust_pkg->part_pkg->categoryname;
701
702   # if we don't have to separate setup/recur/usage, or put this in a 
703   # package-specific section, or display a usage summary, then don't 
704   # even create one of these.  The item will just display in the unnamed
705   # section as a single line plus details.
706   return $self->set('display', [])
707     unless $separate || $categoryname || $usage_mandate;
708   
709   my @display = ();
710
711   my %hash = ( 'section' => $categoryname );
712
713   # whether to put usage details in a separate section, and if so, which one
714   my $usage_section =            $part_pkg->option('usage_section', 'Hush!')
715                     || $cust_pkg->part_pkg->option('usage_section', 'Hush!');
716
717   # whether to show a usage summary line (total usage charges, no details)
718   my $summary =            $part_pkg->option('summarize_usage', 'Hush!')
719               || $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
720
721   if ( $separate ) {
722     # create lines for setup and (non-usage) recur, in the main section
723     push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
724     push @display, new FS::cust_bill_pkg_display { type => 'R', %hash };
725   } else {
726     # display everything in a single line
727     push @display, new FS::cust_bill_pkg_display
728                      { type => '',
729                        %hash,
730                        # and if usage_mandate is enabled, hide details
731                        # (this only works on multisection invoices...)
732                        ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
733                      };
734   }
735
736   if ($separate && $usage_section && $summary) {
737     # create a line for the usage summary in the main section
738     push @display, new FS::cust_bill_pkg_display { type    => 'U',
739                                                    summary => 'Y',
740                                                    %hash,
741                                                  };
742   }
743
744   if ($usage_mandate || ($usage_section && $summary) ) {
745     $hash{post_total} = 'Y';
746   }
747
748   if ($separate || $usage_mandate) {
749     # show call details for this line item in the usage section.
750     # if usage_mandate is on, this will display below the section subtotal.
751     # this also happens if usage is in a separate section and there's a 
752     # summary in the main section, though I'm not sure why.
753     $hash{section} = $usage_section if $usage_section;
754     push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
755   }
756
757   $self->set('display', \@display);
758
759 }
760
761 =item disintegrate
762
763 Returns a hash: keys are "setup", "recur" or usage classnum, values are
764 FS::cust_bill_pkg objects, each with no more than a single class (setup or
765 recur) of charge.
766
767 =cut
768
769 sub disintegrate {
770   my $self = shift;
771   # XXX this goes away with cust_bill_pkg refactor
772
773   my $cust_bill_pkg = new FS::cust_bill_pkg { $self->hash };
774   my %cust_bill_pkg = ();
775
776   $cust_bill_pkg{setup} = $cust_bill_pkg if $cust_bill_pkg->setup;
777   $cust_bill_pkg{recur} = $cust_bill_pkg if $cust_bill_pkg->recur;
778
779
780   #split setup and recur
781   if ($cust_bill_pkg->setup && $cust_bill_pkg->recur) {
782     my $cust_bill_pkg_recur = new FS::cust_bill_pkg { $cust_bill_pkg->hash };
783     $cust_bill_pkg->set('details', []);
784     $cust_bill_pkg->recur(0);
785     $cust_bill_pkg->unitrecur(0);
786     $cust_bill_pkg->type('');
787     $cust_bill_pkg_recur->setup(0);
788     $cust_bill_pkg_recur->unitsetup(0);
789     $cust_bill_pkg{recur} = $cust_bill_pkg_recur;
790
791   }
792
793   #split usage from recur
794   my $usage = sprintf( "%.2f", $cust_bill_pkg{recur}->usage )
795     if exists($cust_bill_pkg{recur});
796   warn "usage is $usage\n" if $DEBUG > 1;
797   if ($usage) {
798     my $cust_bill_pkg_usage =
799         new FS::cust_bill_pkg { $cust_bill_pkg{recur}->hash };
800     $cust_bill_pkg_usage->recur( $usage );
801     $cust_bill_pkg_usage->type( 'U' );
802     my $recur = sprintf( "%.2f", $cust_bill_pkg{recur}->recur - $usage );
803     $cust_bill_pkg{recur}->recur( $recur );
804     $cust_bill_pkg{recur}->type( '' );
805     $cust_bill_pkg{recur}->set('details', []);
806     $cust_bill_pkg{''} = $cust_bill_pkg_usage;
807   }
808
809   #subdivide usage by usage_class
810   if (exists($cust_bill_pkg{''})) {
811     foreach my $class (grep { $_ } $self->usage_classes) {
812       my $usage = sprintf( "%.2f", $cust_bill_pkg{''}->usage($class) );
813       my $cust_bill_pkg_usage =
814           new FS::cust_bill_pkg { $cust_bill_pkg{''}->hash };
815       $cust_bill_pkg_usage->recur( $usage );
816       $cust_bill_pkg_usage->set('details', []);
817       my $classless = sprintf( "%.2f", $cust_bill_pkg{''}->recur - $usage );
818       $cust_bill_pkg{''}->recur( $classless );
819       $cust_bill_pkg{$class} = $cust_bill_pkg_usage;
820     }
821     warn "Unexpected classless usage value: ". $cust_bill_pkg{''}->recur
822       if ($cust_bill_pkg{''}->recur && $cust_bill_pkg{''}->recur < 0);
823     delete $cust_bill_pkg{''}
824       unless ($cust_bill_pkg{''}->recur && $cust_bill_pkg{''}->recur > 0);
825   }
826
827 #  # sort setup,recur,'', and the rest numeric && return
828 #  my @result = map { $cust_bill_pkg{$_} }
829 #               sort { my $ad = ($a=~/^\d+$/); my $bd = ($b=~/^\d+$/);
830 #                      ( $ad cmp $bd ) || ( $ad ? $a<=>$b : $b cmp $a )
831 #                    }
832 #               keys %cust_bill_pkg;
833 #
834 #  return (@result);
835
836    %cust_bill_pkg;
837 }
838
839 =item usage CLASSNUM
840
841 Returns the amount of the charge associated with usage class CLASSNUM if
842 CLASSNUM is defined.  Otherwise returns the total charge associated with
843 usage.
844   
845 =cut
846
847 sub usage {
848   my( $self, $classnum ) = @_;
849   $self->regularize_details;
850
851   if ( $self->get('details') ) {
852
853     return sum( 0, 
854       map { $_->amount || 0 }
855       grep { !defined($classnum) or $classnum eq $_->classnum }
856       @{ $self->get('details') }
857     );
858
859   } else {
860
861     my $sql = 'SELECT SUM(COALESCE(amount,0)) FROM cust_bill_pkg_detail '.
862               ' WHERE billpkgnum = '. $self->billpkgnum;
863     $sql .= " AND classnum = $classnum" if defined($classnum);
864
865     my $sth = dbh->prepare($sql) or die dbh->errstr;
866     $sth->execute or die $sth->errstr;
867
868     return $sth->fetchrow_arrayref->[0] || 0;
869
870   }
871
872 }
873
874 =item usage_classes
875
876 Returns a list of usage classnums associated with this invoice line's
877 details.
878   
879 =cut
880
881 sub usage_classes {
882   my( $self ) = @_;
883   $self->regularize_details;
884
885   if ( $self->get('details') ) {
886
887     my %seen = ( map { $_->classnum => 1 } @{ $self->get('details') } );
888     keys %seen;
889
890   } else {
891
892     map { $_->classnum }
893         qsearch({ table   => 'cust_bill_pkg_detail',
894                   hashref => { billpkgnum => $self->billpkgnum },
895                   select  => 'DISTINCT classnum',
896                });
897
898   }
899
900 }
901
902 sub cust_tax_exempt_pkg {
903   my ( $self ) = @_;
904
905   $self->{Hash}->{cust_tax_exempt_pkg} ||= [];
906 }
907
908 =item cust_bill_pkg_tax_Xlocation
909
910 Returns the list of associated cust_bill_pkg_tax_location and/or
911 cust_bill_pkg_tax_rate_location objects
912
913 =cut
914
915 sub cust_bill_pkg_tax_Xlocation {
916   my $self = shift;
917
918   my %hash = ( 'billpkgnum' => $self->billpkgnum );
919
920   (
921     qsearch ( 'cust_bill_pkg_tax_location', { %hash  } ),
922     qsearch ( 'cust_bill_pkg_tax_rate_location', { %hash } )
923   );
924
925 }
926
927 =item recur_show_zero
928
929 =cut
930
931 sub recur_show_zero { shift->_X_show_zero('recur'); }
932 sub setup_show_zero { shift->_X_show_zero('setup'); }
933
934 sub _X_show_zero {
935   my( $self, $what ) = @_;
936
937   return 0 unless $self->$what() == 0 && $self->pkgnum;
938
939   $self->cust_pkg->_X_show_zero($what);
940 }
941
942 =item credited [ BEFORE, AFTER, OPTIONS ]
943
944 Returns the sum of credits applied to this item.  Arguments are the same as
945 owed_sql/paid_sql/credited_sql.
946
947 =cut
948
949 sub credited {
950   my $self = shift;
951   $self->scalar_sql('SELECT '. $self->credited_sql(@_).' FROM cust_bill_pkg WHERE billpkgnum = ?', $self->billpkgnum);
952 }
953
954 =item tax_locationnum
955
956 Returns the L<FS::cust_location> number that this line item is in for tax
957 purposes.  For package sales, it's the package tax location; for fees, 
958 it's the customer's default service location.
959
960 =cut
961
962 sub tax_locationnum {
963   my $self = shift;
964   if ( $self->pkgnum ) { # normal sales
965     return $self->cust_pkg->tax_locationnum;
966   } elsif ( $self->feepart ) { # fees
967     return $self->cust_bill->cust_main->ship_locationnum;
968   } else { # taxes
969     return '';
970   }
971 }
972
973 sub tax_location {
974   my $self = shift;
975   if ( $self->pkgnum ) { # normal sales
976     return $self->cust_pkg->tax_location;
977   } elsif ( $self->feepart ) { # fees
978     return $self->cust_bill->cust_main->ship_location;
979   } else { # taxes
980     return;
981   }
982 }
983
984 =item part_X
985
986 Returns the L<FS::part_pkg> or L<FS::part_fee> object that defines this
987 charge.  If called on a tax line, returns nothing.
988
989 =cut
990
991 sub part_X {
992   my $self = shift;
993   if ( $self->pkgpart_override ) {
994     return FS::part_pkg->by_key($self->pkgpart_override);
995   } elsif ( $self->pkgnum ) {
996     return $self->cust_pkg->part_pkg;
997   } elsif ( $self->feepart ) {
998     return $self->part_fee;
999   } else {
1000     return;
1001   }
1002 }
1003
1004 =back
1005
1006 =head1 CLASS METHODS
1007
1008 =over 4
1009
1010 =item usage_sql
1011
1012 Returns an SQL expression for the total usage charges in details on
1013 an item.
1014
1015 =cut
1016
1017 my $usage_sql =
1018   '(SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0) 
1019     FROM cust_bill_pkg_detail 
1020     WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum)';
1021
1022 sub usage_sql { $usage_sql }
1023
1024 # this makes owed_sql, etc. much more concise
1025 sub charged_sql {
1026   my ($class, $start, $end, %opt) = @_;
1027   my $setuprecur = $opt{setuprecur} || '';
1028   my $charged = 
1029     $setuprecur =~ /^s/ ? 'cust_bill_pkg.setup' :
1030     $setuprecur =~ /^r/ ? 'cust_bill_pkg.recur' :
1031     'cust_bill_pkg.setup + cust_bill_pkg.recur';
1032
1033   if ($opt{no_usage} and $charged =~ /recur/) { 
1034     $charged = "$charged - $usage_sql"
1035   }
1036
1037   $charged;
1038 }
1039
1040
1041 =item owed_sql [ BEFORE, AFTER, OPTIONS ]
1042
1043 Returns an SQL expression for the amount owed.  BEFORE and AFTER specify
1044 a date window.  OPTIONS may include 'no_usage' (excludes usage charges)
1045 and 'setuprecur' (set to "setup" or "recur" to limit to one or the other).
1046
1047 =cut
1048
1049 sub owed_sql {
1050   my $class = shift;
1051   '(' . $class->charged_sql(@_) . 
1052   ' - ' . $class->paid_sql(@_) .
1053   ' - ' . $class->credited_sql(@_) . ')'
1054 }
1055
1056 =item paid_sql [ BEFORE, AFTER, OPTIONS ]
1057
1058 Returns an SQL expression for the sum of payments applied to this item.
1059
1060 =cut
1061
1062 sub paid_sql {
1063   my ($class, $start, $end, %opt) = @_;
1064   my $s = $start ? "AND cust_pay._date <= $start" : '';
1065   my $e = $end   ? "AND cust_pay._date >  $end"   : '';
1066   my $setuprecur = $opt{setuprecur} || '';
1067   $setuprecur = 'setup' if $setuprecur =~ /^s/;
1068   $setuprecur = 'recur' if $setuprecur =~ /^r/;
1069   $setuprecur &&= "AND setuprecur = '$setuprecur'";
1070
1071   my $paid = "( SELECT COALESCE(SUM(cust_bill_pay_pkg.amount),0)
1072      FROM cust_bill_pay_pkg JOIN cust_bill_pay USING (billpaynum)
1073                             JOIN cust_pay      USING (paynum)
1074      WHERE cust_bill_pay_pkg.billpkgnum = cust_bill_pkg.billpkgnum
1075            $s $e $setuprecur )";
1076
1077   if ( $opt{no_usage} ) {
1078     # cap the amount paid at the sum of non-usage charges, 
1079     # minus the amount credited against non-usage charges
1080     "LEAST($paid, ". 
1081       $class->charged_sql($start, $end, %opt) . ' - ' .
1082       $class->credited_sql($start, $end, %opt).')';
1083   }
1084   else {
1085     $paid;
1086   }
1087
1088 }
1089
1090 sub credited_sql {
1091   my ($class, $start, $end, %opt) = @_;
1092   my $s = $start ? "AND cust_credit._date <= $start" : '';
1093   my $e = $end   ? "AND cust_credit._date >  $end"   : '';
1094   my $setuprecur = $opt{setuprecur} || '';
1095   $setuprecur = 'setup' if $setuprecur =~ /^s/;
1096   $setuprecur = 'recur' if $setuprecur =~ /^r/;
1097   $setuprecur &&= "AND setuprecur = '$setuprecur'";
1098
1099   my $credited = "( SELECT COALESCE(SUM(cust_credit_bill_pkg.amount),0)
1100      FROM cust_credit_bill_pkg JOIN cust_credit_bill USING (creditbillnum)
1101                                JOIN cust_credit      USING (crednum)
1102      WHERE cust_credit_bill_pkg.billpkgnum = cust_bill_pkg.billpkgnum
1103            $s $e $setuprecur )";
1104
1105   if ( $opt{no_usage} ) {
1106     # cap the amount credited at the sum of non-usage charges
1107     "LEAST($credited, ". $class->charged_sql($start, $end, %opt).')';
1108   }
1109   else {
1110     $credited;
1111   }
1112
1113 }
1114
1115 sub upgrade_tax_location {
1116   # For taxes that were calculated/invoiced before cust_location refactoring
1117   # (May-June 2012), there are no cust_bill_pkg_tax_location records unless
1118   # they were calculated on a package-location basis.  Create them here, 
1119   # along with any necessary cust_location records and any tax exemption 
1120   # records.
1121
1122   my ($class, %opt) = @_;
1123   # %opt may include 's' and 'e': start and end date ranges
1124   # and 'X': abort on any error, instead of just rolling back changes to 
1125   # that invoice
1126   my $dbh = dbh;
1127   my $oldAutoCommit = $FS::UID::AutoCommit;
1128   local $FS::UID::AutoCommit = 0;
1129
1130   eval {
1131     use FS::h_cust_main;
1132     use FS::h_cust_bill;
1133     use FS::h_part_pkg;
1134     use FS::h_cust_main_exemption;
1135   };
1136
1137   local $FS::cust_location::import = 1;
1138
1139   my $conf = FS::Conf->new; # h_conf?
1140   return if $conf->exists('enable_taxproducts'); #don't touch this case
1141   my $use_ship = $conf->exists('tax-ship_address');
1142
1143   my $date_where = '';
1144   if ($opt{s}) {
1145     $date_where .= " AND cust_bill._date >= $opt{s}";
1146   }
1147   if ($opt{e}) {
1148     $date_where .= " AND cust_bill._date < $opt{e}";
1149   }
1150
1151   my $commit_each_invoice = 1 unless $opt{X};
1152
1153   # if an invoice has either of these kinds of objects, then it doesn't
1154   # need to be upgraded...probably
1155   my $sub_has_tax_link = 'SELECT 1 FROM cust_bill_pkg_tax_location'.
1156   ' JOIN cust_bill_pkg USING (billpkgnum)'.
1157   ' WHERE cust_bill_pkg.invnum = cust_bill.invnum';
1158   my $sub_has_exempt = 'SELECT 1 FROM cust_tax_exempt_pkg'.
1159   ' JOIN cust_bill_pkg USING (billpkgnum)'.
1160   ' WHERE cust_bill_pkg.invnum = cust_bill.invnum'.
1161   ' AND exempt_monthly IS NULL';
1162
1163   my $search = FS::Cursor->new({
1164       table => 'cust_bill',
1165       hashref => {},
1166       extra_sql => "WHERE NOT EXISTS($sub_has_tax_link) ".
1167                    "AND NOT EXISTS($sub_has_exempt) ".
1168                     $date_where,
1169   });
1170
1171 #print "Processing ".scalar(@invnums)." invoices...\n";
1172
1173   my $committed;
1174   INVOICE:
1175   while (my $cust_bill = $search->fetch) {
1176     my $invnum = $cust_bill->invnum;
1177     $committed = 0;
1178     print STDERR "Invoice #$invnum\n";
1179     my $pre = '';
1180     my %pkgpart_taxclass; # pkgpart => taxclass
1181     my %pkgpart_exempt_setup;
1182     my %pkgpart_exempt_recur;
1183     my $h_cust_bill = qsearchs('h_cust_bill',
1184       { invnum => $invnum,
1185         history_action => 'insert' });
1186     if (!$h_cust_bill) {
1187       warn "no insert record for invoice $invnum; skipped\n";
1188       #$date = $cust_bill->_date as a fallback?
1189       # We're trying to avoid using non-real dates (-d/-y invoice dates)
1190       # when looking up history records in other tables.
1191       next INVOICE;
1192     }
1193     my $custnum = $h_cust_bill->custnum;
1194
1195     # Determine the address corresponding to this tax region.
1196     # It's either the bill or ship address of the customer as of the
1197     # invoice date-of-insertion.  (Not necessarily the invoice date.)
1198     my $date = $h_cust_bill->history_date;
1199     my $h_cust_main = qsearchs('h_cust_main',
1200         { custnum => $custnum },
1201         FS::h_cust_main->sql_h_searchs($date)
1202       );
1203     if (!$h_cust_main ) {
1204       warn "no historical address for cust#".$h_cust_bill->custnum."; skipped\n";
1205       next INVOICE;
1206       # fallback to current $cust_main?  sounds dangerous.
1207     }
1208
1209     # This is a historical customer record, so it has a historical address.
1210     # If there's no cust_location matching this custnum and address (there 
1211     # probably isn't), create one.
1212     $pre = 'ship_' if $use_ship and length($h_cust_main->get('ship_last'));
1213     my %hash = map { $_ => $h_cust_main->get($pre.$_) }
1214                   FS::cust_main->location_fields;
1215     # not really needed for this, and often result in duplicate locations
1216     delete @hash{qw(censustract censusyear latitude longitude coord_auto)};
1217
1218     $hash{custnum} = $h_cust_main->custnum;
1219     my $tax_loc = FS::cust_location->new(\%hash);
1220     my $error = $tax_loc->find_or_insert || $tax_loc->disable_if_unused;
1221     if ( $error ) {
1222       warn "couldn't create historical location record for cust#".
1223       $h_cust_main->custnum.": $error\n";
1224       next INVOICE;
1225     }
1226     my $exempt_cust = 1 if $h_cust_main->tax;
1227
1228     # Get any per-customer taxname exemptions that were in effect.
1229     my %exempt_cust_taxname = map {
1230       $_->taxname => 1
1231     } qsearch('h_cust_main_exemption', { 'custnum' => $custnum },
1232       FS::h_cust_main_exemption->sql_h_searchs($date)
1233     );
1234
1235     # classify line items
1236     my @tax_items;
1237     my %nontax_items; # taxclass => array of cust_bill_pkg
1238     foreach my $item ($h_cust_bill->cust_bill_pkg) {
1239       my $pkgnum = $item->pkgnum;
1240
1241       if ( $pkgnum == 0 ) {
1242
1243         push @tax_items, $item;
1244
1245       } else {
1246         # (pkgparts really shouldn't change, right?)
1247         my $h_cust_pkg = qsearchs('h_cust_pkg', { pkgnum => $pkgnum },
1248           FS::h_cust_pkg->sql_h_searchs($date)
1249         );
1250         if ( !$h_cust_pkg ) {
1251           warn "no historical package #".$item->pkgpart."; skipped\n";
1252           next INVOICE;
1253         }
1254         my $pkgpart = $h_cust_pkg->pkgpart;
1255
1256         if (!exists $pkgpart_taxclass{$pkgpart}) {
1257           my $h_part_pkg = qsearchs('h_part_pkg', { pkgpart => $pkgpart },
1258             FS::h_part_pkg->sql_h_searchs($date)
1259           );
1260           if ( !$h_part_pkg ) {
1261             warn "no historical package def #$pkgpart; skipped\n";
1262             next INVOICE;
1263           }
1264           $pkgpart_taxclass{$pkgpart} = $h_part_pkg->taxclass || '';
1265           $pkgpart_exempt_setup{$pkgpart} = 1 if $h_part_pkg->setuptax;
1266           $pkgpart_exempt_recur{$pkgpart} = 1 if $h_part_pkg->recurtax;
1267         }
1268         
1269         # mark any exemptions that apply
1270         if ( $pkgpart_exempt_setup{$pkgpart} ) {
1271           $item->set('exempt_setup' => 1);
1272         }
1273
1274         if ( $pkgpart_exempt_recur{$pkgpart} ) {
1275           $item->set('exempt_recur' => 1);
1276         }
1277
1278         my $taxclass = $pkgpart_taxclass{ $pkgpart };
1279
1280         $nontax_items{$taxclass} ||= [];
1281         push @{ $nontax_items{$taxclass} }, $item;
1282       }
1283     }
1284     printf("%d tax items: \$%.2f\n", scalar(@tax_items), map {$_->setup} @tax_items)
1285       if @tax_items;
1286
1287     # Use a variation on the procedure in 
1288     # FS::cust_main::Billing::_handle_taxes to identify taxes that apply 
1289     # to this bill.
1290     my @loc_keys = qw( district city county state country );
1291     my %taxhash = map { $_ => $h_cust_main->get($pre.$_) } @loc_keys;
1292     my %taxdef_by_name; # by name, and then by taxclass
1293     my %est_tax; # by name, and then by taxclass
1294     my %taxable_items; # by taxnum, and then an array
1295
1296     foreach my $taxclass (keys %nontax_items) {
1297       my %myhash = %taxhash;
1298       my @elim = qw( district city county state );
1299       my @taxdefs; # because there may be several with different taxnames
1300       do {
1301         $myhash{taxclass} = $taxclass;
1302         @taxdefs = qsearch('cust_main_county', \%myhash);
1303         if ( !@taxdefs ) {
1304           $myhash{taxclass} = '';
1305           @taxdefs = qsearch('cust_main_county', \%myhash);
1306         }
1307         $myhash{ shift @elim } = '';
1308       } while scalar(@elim) and !@taxdefs;
1309
1310       print "Class '$taxclass': ". scalar(@{ $nontax_items{$taxclass} }).
1311             " items, ". scalar(@taxdefs)." tax defs found.\n";
1312       foreach my $taxdef (@taxdefs) {
1313         next if $taxdef->tax == 0;
1314         $taxdef_by_name{$taxdef->taxname}{$taxdef->taxclass} = $taxdef;
1315
1316         $taxable_items{$taxdef->taxnum} ||= [];
1317         foreach my $orig_item (@{ $nontax_items{$taxclass} }) {
1318           # clone the item so that taxdef-dependent changes don't
1319           # change it for other taxdefs
1320           my $item = FS::cust_bill_pkg->new({ $orig_item->hash });
1321
1322           # these flags are already set if the part_pkg declares itself exempt
1323           $item->set('exempt_setup' => 1) if $taxdef->setuptax;
1324           $item->set('exempt_recur' => 1) if $taxdef->recurtax;
1325
1326           my @new_exempt;
1327           my $taxable = $item->setup + $item->recur;
1328           # credits
1329           # h_cust_credit_bill_pkg?
1330           # NO.  Because if these exemptions HAD been created at the time of 
1331           # billing, and then a credit applied later, the exemption would 
1332           # have been adjusted by the amount of the credit.  So we adjust
1333           # the taxable amount before creating the exemption.
1334           # But don't deduct the credit from taxable, because the tax was 
1335           # calculated before the credit was applied.
1336           foreach my $f (qw(setup recur)) {
1337             my $credited = FS::Record->scalar_sql(
1338               "SELECT SUM(amount) FROM cust_credit_bill_pkg ".
1339               "WHERE billpkgnum = ? AND setuprecur = ?",
1340               $item->billpkgnum,
1341               $f
1342             );
1343             $item->set($f, $item->get($f) - $credited) if $credited;
1344           }
1345           my $existing_exempt = FS::Record->scalar_sql(
1346             "SELECT SUM(amount) FROM cust_tax_exempt_pkg WHERE ".
1347             "billpkgnum = ? AND taxnum = ?",
1348             $item->billpkgnum, $taxdef->taxnum
1349           ) || 0;
1350           $taxable -= $existing_exempt;
1351
1352           if ( $taxable and $exempt_cust ) {
1353             push @new_exempt, { exempt_cust => 'Y',  amount => $taxable };
1354             $taxable = 0;
1355           }
1356           if ( $taxable and $exempt_cust_taxname{$taxdef->taxname} ){
1357             push @new_exempt, { exempt_cust_taxname => 'Y', amount => $taxable };
1358             $taxable = 0;
1359           }
1360           if ( $taxable and $item->exempt_setup ) {
1361             push @new_exempt, { exempt_setup => 'Y', amount => $item->setup };
1362             $taxable -= $item->setup;
1363           }
1364           if ( $taxable and $item->exempt_recur ) {
1365             push @new_exempt, { exempt_recur => 'Y', amount => $item->recur };
1366             $taxable -= $item->recur;
1367           }
1368
1369           $item->set('taxable' => $taxable);
1370           push @{ $taxable_items{$taxdef->taxnum} }, $item
1371             if $taxable > 0;
1372
1373           # estimate the amount of tax (this is necessary because different
1374           # taxdefs with the same taxname may have different tax rates) 
1375           # and sum that for each taxname/taxclass combination
1376           # (in cents)
1377           $est_tax{$taxdef->taxname} ||= {};
1378           $est_tax{$taxdef->taxname}{$taxdef->taxclass} ||= 0;
1379           $est_tax{$taxdef->taxname}{$taxdef->taxclass} += 
1380             $taxable * $taxdef->tax;
1381
1382           foreach (@new_exempt) {
1383             next if $_->{amount} == 0;
1384             my $cust_tax_exempt_pkg = FS::cust_tax_exempt_pkg->new({
1385                 %$_,
1386                 billpkgnum  => $item->billpkgnum,
1387                 taxnum      => $taxdef->taxnum,
1388               });
1389             my $error = $cust_tax_exempt_pkg->insert;
1390             if ($error) {
1391               my $pkgnum = $item->pkgnum;
1392               warn "error creating tax exemption for inv$invnum pkg$pkgnum:".
1393                 "\n$error\n\n";
1394               next INVOICE;
1395             }
1396           } #foreach @new_exempt
1397         } #foreach $item
1398       } #foreach $taxdef
1399     } #foreach $taxclass
1400
1401     # Now go through the billed taxes and match them up with the line items.
1402     TAX_ITEM: foreach my $tax_item ( @tax_items )
1403     {
1404       my $taxname = $tax_item->itemdesc;
1405       $taxname = '' if $taxname eq 'Tax';
1406
1407       if ( !exists( $taxdef_by_name{$taxname} ) ) {
1408         # then we didn't find any applicable taxes with this name
1409         warn "no definition found for tax item '$taxname'.\n".
1410           '('.join(' ', @hash{qw(country state county city district)}).")\n";
1411         # possibly all of these should be "next TAX_ITEM", but whole invoices
1412         # are transaction protected and we can go back and retry them.
1413         next INVOICE;
1414       }
1415       # classname => cust_main_county
1416       my %taxdef_by_class = %{ $taxdef_by_name{$taxname} };
1417
1418       # Divide the tax item among taxclasses, if necessary
1419       # classname => estimated tax amount
1420       my $this_est_tax = $est_tax{$taxname};
1421       if (!defined $this_est_tax) {
1422         warn "no taxable sales found for inv#$invnum, tax item '$taxname'.\n";
1423         next INVOICE;
1424       }
1425       my $est_total = sum(values %$this_est_tax);
1426       if ( $est_total == 0 ) {
1427         # shouldn't happen
1428         warn "estimated tax on invoice #$invnum is zero.\n";
1429         next INVOICE;
1430       }
1431
1432       my $real_tax = $tax_item->setup;
1433       printf ("Distributing \$%.2f tax:\n", $real_tax);
1434       my $cents_remaining = $real_tax * 100; # for rounding error
1435       my @tax_links; # partial CBPTL hashrefs
1436       foreach my $taxclass (keys %taxdef_by_class) {
1437         my $taxdef = $taxdef_by_class{$taxclass};
1438         # these items already have "taxable" set to their charge amount
1439         # after applying any credits or exemptions
1440         my @items = @{ $taxable_items{$taxdef->taxnum} };
1441         my $subtotal = sum(map {$_->get('taxable')} @items);
1442         printf("\t$taxclass: %.2f\n", $this_est_tax->{$taxclass}/$est_total);
1443
1444         foreach my $nontax (@items) {
1445           my $part = int($real_tax
1446                             # class allocation
1447                          * ($this_est_tax->{$taxclass}/$est_total) 
1448                             # item allocation
1449                          * ($nontax->get('taxable'))/$subtotal
1450                             # convert to cents
1451                          * 100
1452                        );
1453           $cents_remaining -= $part;
1454           push @tax_links, {
1455             taxnum      => $taxdef->taxnum,
1456             pkgnum      => $nontax->pkgnum,
1457             billpkgnum  => $nontax->billpkgnum,
1458             cents       => $part,
1459           };
1460         } #foreach $nontax
1461       } #foreach $taxclass
1462       # Distribute any leftover tax round-robin style, one cent at a time.
1463       my $i = 0;
1464       my $nlinks = scalar(@tax_links);
1465       if ( $nlinks ) {
1466         # ensure that it really is an integer
1467         $cents_remaining = sprintf('%.0f', $cents_remaining);
1468         while ($cents_remaining > 0) {
1469           $tax_links[$i % $nlinks]->{cents} += 1;
1470           $cents_remaining--;
1471           $i++;
1472         }
1473       } else {
1474         warn "Can't create tax links--no taxable items found.\n";
1475         next INVOICE;
1476       }
1477
1478       # Gather credit/payment applications so that we can link them
1479       # appropriately.
1480       my @unlinked = (
1481         qsearch( 'cust_credit_bill_pkg',
1482           { billpkgnum => $tax_item->billpkgnum, billpkgtaxlocationnum => '' }
1483         ),
1484         qsearch( 'cust_bill_pay_pkg',
1485           { billpkgnum => $tax_item->billpkgnum, billpkgtaxlocationnum => '' }
1486         )
1487       );
1488
1489       # grab the first one
1490       my $this_unlinked = shift @unlinked;
1491       my $unlinked_cents = int($this_unlinked->amount * 100) if $this_unlinked;
1492
1493       # Create tax links (yay!)
1494       printf("Creating %d tax links.\n",scalar(@tax_links));
1495       foreach (@tax_links) {
1496         my $link = FS::cust_bill_pkg_tax_location->new({
1497             billpkgnum  => $tax_item->billpkgnum,
1498             taxtype     => 'FS::cust_main_county',
1499             locationnum => $tax_loc->locationnum,
1500             taxnum      => $_->{taxnum},
1501             pkgnum      => $_->{pkgnum},
1502             amount      => sprintf('%.2f', $_->{cents} / 100),
1503             taxable_billpkgnum => $_->{billpkgnum},
1504         });
1505         my $error = $link->insert;
1506         if ( $error ) {
1507           warn "Can't create tax link for inv#$invnum: $error\n";
1508           next INVOICE;
1509         }
1510
1511         my $link_cents = $_->{cents};
1512         # update/create subitem links
1513         #
1514         # If $this_unlinked is undef, then we've allocated all of the
1515         # credit/payment applications to the tax item.  If $link_cents is 0,
1516         # then we've applied credits/payments to all of this package fraction,
1517         # so go on to the next.
1518         while ($this_unlinked and $link_cents) {
1519           # apply as much as possible of $link_amount to this credit/payment
1520           # link
1521           my $apply_cents = min($link_cents, $unlinked_cents);
1522           $link_cents -= $apply_cents;
1523           $unlinked_cents -= $apply_cents;
1524           # $link_cents or $unlinked_cents or both are now zero
1525           $this_unlinked->set('amount' => sprintf('%.2f',$apply_cents/100));
1526           $this_unlinked->set('billpkgtaxlocationnum' => $link->billpkgtaxlocationnum);
1527           my $pkey = $this_unlinked->primary_key; #creditbillpkgnum or billpaypkgnum
1528           if ( $this_unlinked->$pkey ) {
1529             # then it's an existing link--replace it
1530             $error = $this_unlinked->replace;
1531           } else {
1532             $this_unlinked->insert;
1533           }
1534           # what do we do with errors at this stage?
1535           if ( $error ) {
1536             warn "Error creating tax application link: $error\n";
1537             next INVOICE; # for lack of a better idea
1538           }
1539           
1540           if ( $unlinked_cents == 0 ) {
1541             # then we've allocated all of this payment/credit application, 
1542             # so grab the next one
1543             $this_unlinked = shift @unlinked;
1544             $unlinked_cents = int($this_unlinked->amount * 100) if $this_unlinked;
1545           } elsif ( $link_cents == 0 ) {
1546             # then we've covered all of this package tax fraction, so split
1547             # off a new application from this one
1548             $this_unlinked = $this_unlinked->new({
1549                 $this_unlinked->hash,
1550                 $pkey     => '',
1551             });
1552             # $unlinked_cents is still what it is
1553           }
1554
1555         } #while $this_unlinked and $link_cents
1556       } #foreach (@tax_links)
1557     } #foreach $tax_item
1558
1559     $dbh->commit if $commit_each_invoice and $oldAutoCommit;
1560     $committed = 1;
1561
1562   } #foreach $invnum
1563   continue {
1564     if (!$committed) {
1565       $dbh->rollback if $oldAutoCommit;
1566       die "Upgrade halted.\n" unless $commit_each_invoice;
1567     }
1568   }
1569
1570   $dbh->commit if $oldAutoCommit and !$commit_each_invoice;
1571   '';
1572 }
1573
1574 sub _upgrade_data {
1575   # Create a queue job to run upgrade_tax_location from January 1, 2012 to 
1576   # the present date.
1577   eval {
1578     use FS::queue;
1579     use Date::Parse 'str2time';
1580   };
1581   my $class = shift;
1582   my $upgrade = 'tax_location_2012';
1583   return if FS::upgrade_journal->is_done($upgrade);
1584   my $job = FS::queue->new({
1585       'job' => 'FS::cust_bill_pkg::upgrade_tax_location'
1586   });
1587   # call it kind of like a class method, not that it matters much
1588   $job->insert($class, 's' => str2time('2012-01-01'));
1589   # if there's a customer location upgrade queued also, wait for it to 
1590   # finish
1591   my $location_job = qsearchs('queue', {
1592       job => 'FS::cust_main::Location::process_upgrade_location'
1593     });
1594   if ( $location_job ) {
1595     $job->depend_insert($location_job->jobnum);
1596   }
1597   # Then mark the upgrade as done, so that we don't queue the job twice
1598   # and somehow run two of them concurrently.
1599   FS::upgrade_journal->set_done($upgrade);
1600   # This upgrade now does the job of assigning taxable_billpkgnums to 
1601   # cust_bill_pkg_tax_location, so set that task done also.
1602   FS::upgrade_journal->set_done('tax_location_taxable_billpkgnum');
1603 }
1604
1605 =back
1606
1607 =head1 BUGS
1608
1609 setup and recur shouldn't be separate fields.  There should be one "amount"
1610 field and a flag to tell you if it is a setup/one-time fee or a recurring fee.
1611
1612 A line item with both should really be two separate records (preserving
1613 sdate and edate for setup fees for recurring packages - that information may
1614 be valuable later).  Invoice generation (cust_main::bill), invoice printing
1615 (cust_bill), tax reports (report_tax.cgi) and line item reports 
1616 (cust_bill_pkg.cgi) would need to be updated.
1617
1618 owed_setup and owed_recur could then be repaced by just owed, and
1619 cust_bill::open_cust_bill_pkg and
1620 cust_bill_ApplicationCommon::apply_to_lineitems could be simplified.
1621
1622 The upgrade procedure is pretty sketchy.
1623
1624 =head1 SEE ALSO
1625
1626 L<FS::Record>, L<FS::cust_bill>, L<FS::cust_pkg>, L<FS::cust_main>, schema.html
1627 from the base documentation.
1628
1629 =cut
1630
1631 1;
1632