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 =item _item_discount
 672
 673 If this item has any discounts, returns a hashref in the format used
 674 by L<FS::Template_Mixin/_items_cust_bill_pkg> to describe the discount(s)
 675 on an invoice. This will contain the keys 'description', 'amount',
 676 'ext_description' (an arrayref of text lines describing the discounts),
 677 and '_is_discount' (a flag).
 678
 679 The value for 'amount' will be negative, and will be scaled for the package
 680 quantity.
 681
 682 =cut
 683
 684 sub _item_discount {
 685   my $self = shift;
 686   my @pkg_discounts = $self->pkg_discount;
 687   return if @pkg_discounts == 0;
 688   # special case: if there are old "discount details" on this line item, don't
 689   # show discount line items
 690   if ( FS::cust_bill_pkg_detail->count("detail LIKE 'Includes discount%' AND billpkgnum = ?", $self->billpkgnum || 0) > 0 ) {
 691     return;
 692   }
 693
 694   my @ext;
 695   my $d = {
 696     _is_discount    => 1,
 697     description     => $self->mt('Discount'),
 698     amount          => 0,
 699     ext_description => \@ext,
 700     # maybe should show quantity/unit discount?
 701   };
 702   foreach my $pkg_discount (@pkg_discounts) {
 703     push @ext, $pkg_discount->description;
 704     $d->{amount} -= $pkg_discount->amount;
 705   }
 706   $d->{amount} *= $self->quantity || 1;
 707
 708   return $d;
 709 }
 710
 711 =item set_display OPTION => VALUE ...
 712
 713 A helper method for I<insert>, populates the pseudo-field B<display> with
 714 appropriate FS::cust_bill_pkg_display objects.
 715
 716 Options are passed as a list of name/value pairs.  Options are:
 717
 718 part_pkg: FS::part_pkg object from this line item's package.
 719
 720 real_pkgpart: if this line item comes from a bundled package, the pkgpart
 721 of the owning package.  Otherwise the same as the part_pkg's pkgpart above.
 722
 723 =cut
 724
 725 sub set_display {
 726   my( $self, %opt ) = @_;
 727   my $part_pkg = $opt{'part_pkg'};
 728   my $cust_pkg = new FS::cust_pkg { pkgpart => $opt{real_pkgpart} };
 729
 730   my $conf = new FS::Conf;
 731
 732   # whether to break this down into setup/recur/usage
 733   my $separate = $conf->exists('separate_usage');
 734
 735   my $usage_mandate =            $part_pkg->option('usage_mandate', 'Hush!')
 736                     || $cust_pkg->part_pkg->option('usage_mandate', 'Hush!');
 737
 738   # or use the category from $opt{'part_pkg'} if its not bundled?
 739   my $categoryname = $cust_pkg->part_pkg->categoryname;
 740
 741   # if we don't have to separate setup/recur/usage, or put this in a
 742   # package-specific section, or display a usage summary, then don't
 743   # even create one of these.  The item will just display in the unnamed
 744   # section as a single line plus details.
 745   return $self->set('display', [])
 746     unless $separate || $categoryname || $usage_mandate;
 747
 748   my @display = ();
 749
 750   my %hash = ( 'section' => $categoryname );
 751
 752   # whether to put usage details in a separate section, and if so, which one
 753   my $usage_section =            $part_pkg->option('usage_section', 'Hush!')
 754                     || $cust_pkg->part_pkg->option('usage_section', 'Hush!');
 755
 756   # whether to show a usage summary line (total usage charges, no details)
 757   my $summary =            $part_pkg->option('summarize_usage', 'Hush!')
 758               || $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
 759
 760   if ( $separate ) {
 761     # create lines for setup and (non-usage) recur, in the main section
 762     push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
 763     push @display, new FS::cust_bill_pkg_display { type => 'R', %hash };
 764   } else {
 765     # display everything in a single line
 766     push @display, new FS::cust_bill_pkg_display
 767                      { type => '',
 768                        %hash,
 769                        # and if usage_mandate is enabled, hide details
 770                        # (this only works on multisection invoices...)
 771                        ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
 772                      };
 773   }
 774
 775   if ($separate && $usage_section && $summary) {
 776     # create a line for the usage summary in the main section
 777     push @display, new FS::cust_bill_pkg_display { type    => 'U',
 778                                                    summary => 'Y',
 779                                                    %hash,
 780                                                  };
 781   }
 782
 783   if ($usage_mandate || ($usage_section && $summary) ) {
 784     $hash{post_total} = 'Y';
 785   }
 786
 787   if ($separate || $usage_mandate) {
 788     # show call details for this line item in the usage section.
 789     # if usage_mandate is on, this will display below the section subtotal.
 790     # this also happens if usage is in a separate section and there's a
 791     # summary in the main section, though I'm not sure why.
 792     $hash{section} = $usage_section if $usage_section;
 793     push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
 794   }
 795
 796   $self->set('display', \@display);
 797
 798 }
 799
 800 =item disintegrate
 801
 802 Returns a hash: keys are "setup", "recur" or usage classnum, values are
 803 FS::cust_bill_pkg objects, each with no more than a single class (setup or
 804 recur) of charge.
 805
 806 =cut
 807
 808 sub disintegrate {
 809   my $self = shift;
 810   # XXX this goes away with cust_bill_pkg refactor
 811
 812   my $cust_bill_pkg = new FS::cust_bill_pkg { $self->hash };
 813   my %cust_bill_pkg = ();
 814
 815   $cust_bill_pkg{setup} = $cust_bill_pkg if $cust_bill_pkg->setup;
 816   $cust_bill_pkg{recur} = $cust_bill_pkg if $cust_bill_pkg->recur;
 817
 818
 819   #split setup and recur
 820   if ($cust_bill_pkg->setup && $cust_bill_pkg->recur) {
 821     my $cust_bill_pkg_recur = new FS::cust_bill_pkg { $cust_bill_pkg->hash };
 822     $cust_bill_pkg->set('details', []);
 823     $cust_bill_pkg->recur(0);
 824     $cust_bill_pkg->unitrecur(0);
 825     $cust_bill_pkg->type('');
 826     $cust_bill_pkg_recur->setup(0);
 827     $cust_bill_pkg_recur->unitsetup(0);
 828     $cust_bill_pkg{recur} = $cust_bill_pkg_recur;
 829
 830   }
 831
 832   #split usage from recur
 833   my $usage = sprintf( "%.2f", $cust_bill_pkg{recur}->usage )
 834     if exists($cust_bill_pkg{recur});
 835   warn "usage is $usage\n" if $DEBUG > 1;
 836   if ($usage) {
 837     my $cust_bill_pkg_usage =
 838         new FS::cust_bill_pkg { $cust_bill_pkg{recur}->hash };
 839     $cust_bill_pkg_usage->recur( $usage );
 840     $cust_bill_pkg_usage->type( 'U' );
 841     my $recur = sprintf( "%.2f", $cust_bill_pkg{recur}->recur - $usage );
 842     $cust_bill_pkg{recur}->recur( $recur );
 843     $cust_bill_pkg{recur}->type( '' );
 844     $cust_bill_pkg{recur}->set('details', []);
 845     $cust_bill_pkg{''} = $cust_bill_pkg_usage;
 846   }
 847
 848   #subdivide usage by usage_class
 849   if (exists($cust_bill_pkg{''})) {
 850     foreach my $class (grep { $_ } $self->usage_classes) {
 851       my $usage = sprintf( "%.2f", $cust_bill_pkg{''}->usage($class) );
 852       my $cust_bill_pkg_usage =
 853           new FS::cust_bill_pkg { $cust_bill_pkg{''}->hash };
 854       $cust_bill_pkg_usage->recur( $usage );
 855       $cust_bill_pkg_usage->set('details', []);
 856       my $classless = sprintf( "%.2f", $cust_bill_pkg{''}->recur - $usage );
 857       $cust_bill_pkg{''}->recur( $classless );
 858       $cust_bill_pkg{$class} = $cust_bill_pkg_usage;
 859     }
 860     warn "Unexpected classless usage value: ". $cust_bill_pkg{''}->recur
 861       if ($cust_bill_pkg{''}->recur && $cust_bill_pkg{''}->recur < 0);
 862     delete $cust_bill_pkg{''}
 863       unless ($cust_bill_pkg{''}->recur && $cust_bill_pkg{''}->recur > 0);
 864   }
 865
 866 #  # sort setup,recur,'', and the rest numeric && return
 867 #  my @result = map { $cust_bill_pkg{$_} }
 868 #               sort { my $ad = ($a=~/^\d+$/); my $bd = ($b=~/^\d+$/);
 869 #                      ( $ad cmp $bd ) || ( $ad ? $a<=>$b : $b cmp $a )
 870 #                    }
 871 #               keys %cust_bill_pkg;
 872 #
 873 #  return (@result);
 874
 875    %cust_bill_pkg;
 876 }
 877
 878 =item usage CLASSNUM
 879
 880 Returns the amount of the charge associated with usage class CLASSNUM if
 881 CLASSNUM is defined.  Otherwise returns the total charge associated with
 882 usage.
 883
 884 =cut
 885
 886 sub usage {
 887   my( $self, $classnum ) = @_;
 888   $self->regularize_details;
 889
 890   if ( $self->get('details') ) {
 891
 892     return sum( 0,
 893       map { $_->amount || 0 }
 894       grep { !defined($classnum) or $classnum eq $_->classnum }
 895       @{ $self->get('details') }
 896     );
 897
 898   } else {
 899
 900     my $sql = 'SELECT SUM(COALESCE(amount,0)) FROM cust_bill_pkg_detail '.
 901               ' WHERE billpkgnum = '. $self->billpkgnum;
 902     $sql .= " AND classnum = $classnum" if defined($classnum);
 903
 904     my $sth = dbh->prepare($sql) or die dbh->errstr;
 905     $sth->execute or die $sth->errstr;
 906
 907     return $sth->fetchrow_arrayref->[0] || 0;
 908
 909   }
 910
 911 }
 912
 913 =item usage_classes
 914
 915 Returns a list of usage classnums associated with this invoice line's
 916 details.
 917
 918 =cut
 919
 920 sub usage_classes {
 921   my( $self ) = @_;
 922   $self->regularize_details;
 923
 924   if ( $self->get('details') ) {
 925
 926     my %seen = ( map { $_->classnum => 1 } @{ $self->get('details') } );
 927     keys %seen;
 928
 929   } else {
 930
 931     map { $_->classnum }
 932         qsearch({ table   => 'cust_bill_pkg_detail',
 933                   hashref => { billpkgnum => $self->billpkgnum },
 934                   select  => 'DISTINCT classnum',
 935                });
 936
 937   }
 938
 939 }
 940
 941 sub cust_tax_exempt_pkg {
 942   my ( $self ) = @_;
 943
 944   $self->{Hash}->{cust_tax_exempt_pkg} ||= [];
 945 }
 946
 947 =item cust_bill_pkg_tax_Xlocation
 948
 949 Returns the list of associated cust_bill_pkg_tax_location and/or
 950 cust_bill_pkg_tax_rate_location objects
 951
 952 =cut
 953
 954 sub cust_bill_pkg_tax_Xlocation {
 955   my $self = shift;
 956
 957   my %hash = ( 'billpkgnum' => $self->billpkgnum );
 958
 959   (
 960     qsearch ( 'cust_bill_pkg_tax_location', { %hash  } ),
 961     qsearch ( 'cust_bill_pkg_tax_rate_location', { %hash } )
 962   );
 963
 964 }
 965
 966 =item recur_show_zero
 967
 968 =cut
 969
 970 sub recur_show_zero { shift->_X_show_zero('recur'); }
 971 sub setup_show_zero { shift->_X_show_zero('setup'); }
 972
 973 sub _X_show_zero {
 974   my( $self, $what ) = @_;
 975
 976   return 0 unless $self->$what() == 0 && $self->pkgnum;
 977
 978   $self->cust_pkg->_X_show_zero($what);
 979 }
 980
 981 =item credited [ BEFORE, AFTER, OPTIONS ]
 982
 983 Returns the sum of credits applied to this item.  Arguments are the same as
 984 owed_sql/paid_sql/credited_sql.
 985
 986 =cut
 987
 988 sub credited {
 989   my $self = shift;
 990   $self->scalar_sql('SELECT '. $self->credited_sql(@_).' FROM cust_bill_pkg WHERE billpkgnum = ?', $self->billpkgnum);
 991 }
 992
 993 =item tax_locationnum
 994
 995 Returns the L<FS::cust_location> number that this line item is in for tax
 996 purposes.  For package sales, it's the package tax location; for fees,
 997 it's the customer's default service location.
 998
 999 =cut
1000
1001 sub tax_locationnum {
1002   my $self = shift;
1003   if ( $self->pkgnum ) { # normal sales
1004     return $self->cust_pkg->tax_locationnum;
1005   } elsif ( $self->feepart ) { # fees
1006     return $self->cust_bill->cust_main->ship_locationnum;
1007   } else { # taxes
1008     return '';
1009   }
1010 }
1011
1012 sub tax_location {
1013   my $self = shift;
1014   if ( $self->pkgnum ) { # normal sales
1015     return $self->cust_pkg->tax_location;
1016   } elsif ( $self->feepart ) { # fees
1017     return $self->cust_bill->cust_main->ship_location;
1018   } else { # taxes
1019     return;
1020   }
1021 }
1022
1023 =item part_X
1024
1025 Returns the L<FS::part_pkg> or L<FS::part_fee> object that defines this
1026 charge.  If called on a tax line, returns nothing.
1027
1028 =cut
1029
1030 sub part_X {
1031   my $self = shift;
1032   if ( $self->pkgpart_override ) {
1033     return FS::part_pkg->by_key($self->pkgpart_override);
1034   } elsif ( $self->pkgnum ) {
1035     return $self->cust_pkg->part_pkg;
1036   } elsif ( $self->feepart ) {
1037     return $self->part_fee;
1038   } else {
1039     return;
1040   }
1041 }
1042
1043 =back
1044
1045 =head1 CLASS METHODS
1046
1047 =over 4
1048
1049 =item usage_sql
1050
1051 Returns an SQL expression for the total usage charges in details on
1052 an item.
1053
1054 =cut
1055
1056 my $usage_sql =
1057   '(SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
1058     FROM cust_bill_pkg_detail
1059     WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum)';
1060
1061 sub usage_sql { $usage_sql }
1062
1063 # this makes owed_sql, etc. much more concise
1064 sub charged_sql {
1065   my ($class, $start, $end, %opt) = @_;
1066   my $setuprecur = $opt{setuprecur} || '';
1067   my $charged =
1068     $setuprecur =~ /^s/ ? 'cust_bill_pkg.setup' :
1069     $setuprecur =~ /^r/ ? 'cust_bill_pkg.recur' :
1070     'cust_bill_pkg.setup + cust_bill_pkg.recur';
1071
1072   if ($opt{no_usage} and $charged =~ /recur/) {
1073     $charged = "$charged - $usage_sql"
1074   }
1075
1076   $charged;
1077 }
1078
1079
1080 =item owed_sql [ BEFORE, AFTER, OPTIONS ]
1081
1082 Returns an SQL expression for the amount owed.  BEFORE and AFTER specify
1083 a date window.  OPTIONS may include 'no_usage' (excludes usage charges)
1084 and 'setuprecur' (set to "setup" or "recur" to limit to one or the other).
1085
1086 =cut
1087
1088 sub owed_sql {
1089   my $class = shift;
1090   '(' . $class->charged_sql(@_) .
1091   ' - ' . $class->paid_sql(@_) .
1092   ' - ' . $class->credited_sql(@_) . ')'
1093 }
1094
1095 =item paid_sql [ BEFORE, AFTER, OPTIONS ]
1096
1097 Returns an SQL expression for the sum of payments applied to this item.
1098
1099 =cut
1100
1101 sub paid_sql {
1102   my ($class, $start, $end, %opt) = @_;
1103   my $s = $start ? "AND cust_pay._date <= $start" : '';
1104   my $e = $end   ? "AND cust_pay._date >  $end"   : '';
1105   my $setuprecur = $opt{setuprecur} || '';
1106   $setuprecur = 'setup' if $setuprecur =~ /^s/;
1107   $setuprecur = 'recur' if $setuprecur =~ /^r/;
1108   $setuprecur &&= "AND setuprecur = '$setuprecur'";
1109
1110   my $paid = "( SELECT COALESCE(SUM(cust_bill_pay_pkg.amount),0)
1111      FROM cust_bill_pay_pkg JOIN cust_bill_pay USING (billpaynum)
1112                             JOIN cust_pay      USING (paynum)
1113      WHERE cust_bill_pay_pkg.billpkgnum = cust_bill_pkg.billpkgnum
1114            $s $e $setuprecur )";
1115
1116   if ( $opt{no_usage} ) {
1117     # cap the amount paid at the sum of non-usage charges,
1118     # minus the amount credited against non-usage charges
1119     "LEAST($paid, ".
1120       $class->charged_sql($start, $end, %opt) . ' - ' .
1121       $class->credited_sql($start, $end, %opt).')';
1122   }
1123   else {
1124     $paid;
1125   }
1126
1127 }
1128
1129 sub credited_sql {
1130   my ($class, $start, $end, %opt) = @_;
1131   my $s = $start ? "AND cust_credit._date <= $start" : '';
1132   my $e = $end   ? "AND cust_credit._date >  $end"   : '';
1133   my $setuprecur = $opt{setuprecur} || '';
1134   $setuprecur = 'setup' if $setuprecur =~ /^s/;
1135   $setuprecur = 'recur' if $setuprecur =~ /^r/;
1136   $setuprecur &&= "AND setuprecur = '$setuprecur'";
1137
1138   my $credited = "( SELECT COALESCE(SUM(cust_credit_bill_pkg.amount),0)
1139      FROM cust_credit_bill_pkg JOIN cust_credit_bill USING (creditbillnum)
1140                                JOIN cust_credit      USING (crednum)
1141      WHERE cust_credit_bill_pkg.billpkgnum = cust_bill_pkg.billpkgnum
1142            $s $e $setuprecur )";
1143
1144   if ( $opt{no_usage} ) {
1145     # cap the amount credited at the sum of non-usage charges
1146     "LEAST($credited, ". $class->charged_sql($start, $end, %opt).')';
1147   }
1148   else {
1149     $credited;
1150   }
1151
1152 }
1153
1154 sub upgrade_tax_location {
1155   # For taxes that were calculated/invoiced before cust_location refactoring
1156   # (May-June 2012), there are no cust_bill_pkg_tax_location records unless
1157   # they were calculated on a package-location basis.  Create them here,
1158   # along with any necessary cust_location records and any tax exemption
1159   # records.
1160
1161   my ($class, %opt) = @_;
1162   # %opt may include 's' and 'e': start and end date ranges
1163   # and 'X': abort on any error, instead of just rolling back changes to
1164   # that invoice
1165   my $dbh = dbh;
1166   my $oldAutoCommit = $FS::UID::AutoCommit;
1167   local $FS::UID::AutoCommit = 0;
1168
1169   eval {
1170     use FS::h_cust_main;
1171     use FS::h_cust_bill;
1172     use FS::h_part_pkg;
1173     use FS::h_cust_main_exemption;
1174   };
1175
1176   local $FS::cust_location::import = 1;
1177
1178   my $conf = FS::Conf->new; # h_conf?
1179   return if $conf->exists('enable_taxproducts'); #don't touch this case
1180   my $use_ship = $conf->exists('tax-ship_address');
1181   my $use_pkgloc = $conf->exists('tax-pkg_address');
1182
1183   my $date_where = '';
1184   if ($opt{s}) {
1185     $date_where .= " AND cust_bill._date >= $opt{s}";
1186   }
1187   if ($opt{e}) {
1188     $date_where .= " AND cust_bill._date < $opt{e}";
1189   }
1190
1191   my $commit_each_invoice = 1 unless $opt{X};
1192
1193   # if an invoice has either of these kinds of objects, then it doesn't
1194   # need to be upgraded...probably
1195   my $sub_has_tax_link = 'SELECT 1 FROM cust_bill_pkg_tax_location'.
1196   ' JOIN cust_bill_pkg USING (billpkgnum)'.
1197   ' WHERE cust_bill_pkg.invnum = cust_bill.invnum';
1198   my $sub_has_exempt = 'SELECT 1 FROM cust_tax_exempt_pkg'.
1199   ' JOIN cust_bill_pkg USING (billpkgnum)'.
1200   ' WHERE cust_bill_pkg.invnum = cust_bill.invnum'.
1201   ' AND exempt_monthly IS NULL';
1202
1203   my %all_tax_names = (
1204     '' => 1,
1205     'Tax' => 1,
1206     map { $_->taxname => 1 }
1207       qsearch('h_cust_main_county', { taxname => { op => '!=', value => '' }})
1208   );
1209
1210   my $search = FS::Cursor->new({
1211       table => 'cust_bill',
1212       hashref => {},
1213       extra_sql => "WHERE NOT EXISTS($sub_has_tax_link) ".
1214                    "AND NOT EXISTS($sub_has_exempt) ".
1215                     $date_where,
1216   });
1217
1218 #print "Processing ".scalar(@invnums)." invoices...\n";
1219
1220   my $committed;
1221   INVOICE:
1222   while (my $cust_bill = $search->fetch) {
1223     my $invnum = $cust_bill->invnum;
1224     $committed = 0;
1225     print STDERR "Invoice #$invnum\n";
1226     my $pre = '';
1227     my %pkgpart_taxclass; # pkgpart => taxclass
1228     my %pkgpart_exempt_setup;
1229     my %pkgpart_exempt_recur;
1230     my $h_cust_bill = qsearchs('h_cust_bill',
1231       { invnum => $invnum,
1232         history_action => 'insert' });
1233     if (!$h_cust_bill) {
1234       warn "no insert record for invoice $invnum; skipped\n";
1235       #$date = $cust_bill->_date as a fallback?
1236       # We're trying to avoid using non-real dates (-d/-y invoice dates)
1237       # when looking up history records in other tables.
1238       next INVOICE;
1239     }
1240     my $custnum = $h_cust_bill->custnum;
1241
1242     # Determine the address corresponding to this tax region.
1243     # It's either the bill or ship address of the customer as of the
1244     # invoice date-of-insertion.  (Not necessarily the invoice date.)
1245     my $date = $h_cust_bill->history_date;
1246     local($FS::Record::qsearch_qualify_columns) = 0;
1247     my $h_cust_main = qsearchs('h_cust_main',
1248         { custnum   => $custnum },
1249         FS::h_cust_main->sql_h_searchs($date)
1250       );
1251     if (!$h_cust_main ) {
1252       warn "no historical address for cust#".$h_cust_bill->custnum."; skipped\n";
1253       next INVOICE;
1254       # fallback to current $cust_main?  sounds dangerous.
1255     }
1256
1257     # This is a historical customer record, so it has a historical address.
1258     # If there's no cust_location matching this custnum and address (there
1259     # probably isn't), create one.
1260     my %tax_loc; # keys are pkgnums, values are cust_location objects
1261     my $default_tax_loc;
1262     if ( $h_cust_main->bill_locationnum ) {
1263       # the location has already been upgraded
1264       if ($use_ship) {
1265         $default_tax_loc = $h_cust_main->ship_location;
1266       } else {
1267         $default_tax_loc = $h_cust_main->bill_location;
1268       }
1269     } else {
1270       $pre = 'ship_' if $use_ship and length($h_cust_main->get('ship_last'));
1271       my %hash = map { $_ => $h_cust_main->get($pre.$_) }
1272                     FS::cust_main->location_fields;
1273       # not really needed for this, and often result in duplicate locations
1274       delete @hash{qw(censustract censusyear latitude longitude coord_auto)};
1275
1276       $hash{custnum} = $h_cust_main->custnum;
1277       $default_tax_loc = FS::cust_location->new(\%hash);
1278       my $error = $default_tax_loc->find_or_insert || $default_tax_loc->disable_if_unused;
1279       if ( $error ) {
1280         warn "couldn't create historical location record for cust#".
1281         $h_cust_main->custnum.": $error\n";
1282         next INVOICE;
1283       }
1284     }
1285     my $exempt_cust;
1286     $exempt_cust = 1 if $h_cust_main->tax;
1287
1288     # classify line items
1289     my @tax_items;
1290     my %nontax_items; # taxclass => array of cust_bill_pkg
1291     foreach my $item ($h_cust_bill->cust_bill_pkg) {
1292       my $pkgnum = $item->pkgnum;
1293
1294       if ( $pkgnum == 0 ) {
1295
1296         push @tax_items, $item;
1297
1298       } else {
1299         # (pkgparts really shouldn't change, right?)
1300         local($FS::Record::qsearch_qualify_columns) = 0;
1301         my $h_cust_pkg = qsearchs('h_cust_pkg', { pkgnum => $pkgnum },
1302           FS::h_cust_pkg->sql_h_searchs($date)
1303         );
1304         if ( !$h_cust_pkg ) {
1305           warn "no historical package #".$item->pkgpart."; skipped\n";
1306           next INVOICE;
1307         }
1308         my $pkgpart = $h_cust_pkg->pkgpart;
1309
1310         if ( $use_pkgloc and $h_cust_pkg->locationnum ) {
1311           # then this package already had a locationnum assigned, and that's
1312           # the one to use for tax calculation
1313           $tax_loc{$pkgnum} = FS::cust_location->by_key($h_cust_pkg->locationnum);
1314         } else {
1315           # use the customer's bill or ship loc, which was inserted earlier
1316           $tax_loc{$pkgnum} = $default_tax_loc;
1317         }
1318
1319         if (!exists $pkgpart_taxclass{$pkgpart}) {
1320           local($FS::Record::qsearch_qualify_columns) = 0;
1321           my $h_part_pkg = qsearchs('h_part_pkg', { pkgpart => $pkgpart },
1322             FS::h_part_pkg->sql_h_searchs($date)
1323           );
1324           if ( !$h_part_pkg ) {
1325             warn "no historical package def #$pkgpart; skipped\n";
1326             next INVOICE;
1327           }
1328           $pkgpart_taxclass{$pkgpart} = $h_part_pkg->taxclass || '';
1329           $pkgpart_exempt_setup{$pkgpart} = 1 if $h_part_pkg->setuptax;
1330           $pkgpart_exempt_recur{$pkgpart} = 1 if $h_part_pkg->recurtax;
1331         }
1332
1333         # mark any exemptions that apply
1334         if ( $pkgpart_exempt_setup{$pkgpart} ) {
1335           $item->set('exempt_setup' => 1);
1336         }
1337
1338         if ( $pkgpart_exempt_recur{$pkgpart} ) {
1339           $item->set('exempt_recur' => 1);
1340         }
1341
1342         my $taxclass = $pkgpart_taxclass{ $pkgpart };
1343
1344         $nontax_items{$taxclass} ||= [];
1345         push @{ $nontax_items{$taxclass} }, $item;
1346       }
1347     }
1348
1349     printf("%d tax items: \$%.2f\n", scalar(@tax_items), map {$_->setup} @tax_items)
1350       if @tax_items;
1351
1352     # Get any per-customer taxname exemptions that were in effect.
1353     my %exempt_cust_taxname;
1354     foreach (keys %all_tax_names) {
1355      local($FS::Record::qsearch_qualify_columns) = 0;
1356       my $h_exemption = qsearchs('h_cust_main_exemption', {
1357           'custnum' => $custnum,
1358           'taxname' => $_,
1359         },
1360         FS::h_cust_main_exemption->sql_h_searchs($date, $date)
1361       );
1362       if ($h_exemption) {
1363         $exempt_cust_taxname{ $_ } = 1;
1364       }
1365     }
1366
1367     # Use a variation on the procedure in
1368     # FS::cust_main::Billing::_handle_taxes to identify taxes that apply
1369     # to this bill.
1370     my @loc_keys = qw( district city county state country );
1371     my %taxdef_by_name; # by name, and then by taxclass
1372     my %est_tax; # by name, and then by taxclass
1373     my %taxable_items; # by taxnum, and then an array
1374
1375     foreach my $taxclass (keys %nontax_items) {
1376       foreach my $orig_item (@{ $nontax_items{$taxclass} }) {
1377         my $my_tax_loc = $tax_loc{ $orig_item->pkgnum };
1378         my %myhash = map { $_ => $my_tax_loc->get($pre.$_) } @loc_keys;
1379         my @elim = qw( district city county state );
1380         my @taxdefs; # because there may be several with different taxnames
1381         do {
1382           $myhash{taxclass} = $taxclass;
1383           @taxdefs = qsearch('cust_main_county', \%myhash);
1384           if ( !@taxdefs ) {
1385             $myhash{taxclass} = '';
1386             @taxdefs = qsearch('cust_main_county', \%myhash);
1387           }
1388           $myhash{ shift @elim } = '';
1389         } while scalar(@elim) and !@taxdefs;
1390
1391         foreach my $taxdef (@taxdefs) {
1392           next if $taxdef->tax == 0;
1393           $taxdef_by_name{$taxdef->taxname}{$taxdef->taxclass} = $taxdef;
1394
1395           $taxable_items{$taxdef->taxnum} ||= [];
1396           # clone the item so that taxdef-dependent changes don't
1397           # change it for other taxdefs
1398           my $item = FS::cust_bill_pkg->new({ $orig_item->hash });
1399
1400           # these flags are already set if the part_pkg declares itself exempt
1401           $item->set('exempt_setup' => 1) if $taxdef->setuptax;
1402           $item->set('exempt_recur' => 1) if $taxdef->recurtax;
1403
1404           my @new_exempt;
1405           my $taxable = $item->setup + $item->recur;
1406           # credits
1407           # h_cust_credit_bill_pkg?
1408           # NO.  Because if these exemptions HAD been created at the time of
1409           # billing, and then a credit applied later, the exemption would
1410           # have been adjusted by the amount of the credit.  So we adjust
1411           # the taxable amount before creating the exemption.
1412           # But don't deduct the credit from taxable, because the tax was
1413           # calculated before the credit was applied.
1414           foreach my $f (qw(setup recur)) {
1415             my $credited = FS::Record->scalar_sql(
1416               "SELECT SUM(amount) FROM cust_credit_bill_pkg ".
1417               "WHERE billpkgnum = ? AND setuprecur = ?",
1418               $item->billpkgnum,
1419               $f
1420             );
1421             $item->set($f, $item->get($f) - $credited) if $credited;
1422           }
1423           my $existing_exempt = FS::Record->scalar_sql(
1424             "SELECT SUM(amount) FROM cust_tax_exempt_pkg WHERE ".
1425             "billpkgnum = ? AND taxnum = ?",
1426             $item->billpkgnum, $taxdef->taxnum
1427           ) || 0;
1428           $taxable -= $existing_exempt;
1429
1430           if ( $taxable and $exempt_cust ) {
1431             push @new_exempt, { exempt_cust => 'Y',  amount => $taxable };
1432             $taxable = 0;
1433           }
1434           if ( $taxable and $exempt_cust_taxname{$taxdef->taxname} ){
1435             push @new_exempt, { exempt_cust_taxname => 'Y', amount => $taxable };
1436             $taxable = 0;
1437           }
1438           if ( $taxable and $item->exempt_setup ) {
1439             push @new_exempt, { exempt_setup => 'Y', amount => $item->setup };
1440             $taxable -= $item->setup;
1441           }
1442           if ( $taxable and $item->exempt_recur ) {
1443             push @new_exempt, { exempt_recur => 'Y', amount => $item->recur };
1444             $taxable -= $item->recur;
1445           }
1446
1447           $item->set('taxable' => $taxable);
1448           push @{ $taxable_items{$taxdef->taxnum} }, $item
1449             if $taxable > 0;
1450
1451           # estimate the amount of tax (this is necessary because different
1452           # taxdefs with the same taxname may have different tax rates)
1453           # and sum that for each taxname/taxclass combination
1454           # (in cents)
1455           $est_tax{$taxdef->taxname} ||= {};
1456           $est_tax{$taxdef->taxname}{$taxdef->taxclass} ||= 0;
1457           $est_tax{$taxdef->taxname}{$taxdef->taxclass} +=
1458             $taxable * $taxdef->tax;
1459
1460           foreach (@new_exempt) {
1461             next if $_->{amount} == 0;
1462             my $cust_tax_exempt_pkg = FS::cust_tax_exempt_pkg->new({
1463                 %$_,
1464                 billpkgnum  => $item->billpkgnum,
1465                 taxnum      => $taxdef->taxnum,
1466               });
1467             my $error = $cust_tax_exempt_pkg->insert;
1468             if ($error) {
1469               my $pkgnum = $item->pkgnum;
1470               warn "error creating tax exemption for inv$invnum pkg$pkgnum:".
1471                 "\n$error\n\n";
1472               next INVOICE;
1473             }
1474           } #foreach @new_exempt
1475         } #foreach $taxdef
1476       } #foreach $item
1477     } #foreach $taxclass
1478
1479     # Now go through the billed taxes and match them up with the line items.
1480     TAX_ITEM: foreach my $tax_item ( @tax_items )
1481     {
1482       my $taxname = $tax_item->itemdesc;
1483       $taxname = '' if $taxname eq 'Tax';
1484
1485       if ( !exists( $taxdef_by_name{$taxname} ) ) {
1486         # then we didn't find any applicable taxes with this name
1487         warn "no definition found for tax item '$taxname', custnum $custnum\n";
1488         # possibly all of these should be "next TAX_ITEM", but whole invoices
1489         # are transaction protected and we can go back and retry them.
1490         next INVOICE;
1491       }
1492       # classname => cust_main_county
1493       my %taxdef_by_class = %{ $taxdef_by_name{$taxname} };
1494
1495       # Divide the tax item among taxclasses, if necessary
1496       # classname => estimated tax amount
1497       my $this_est_tax = $est_tax{$taxname};
1498       if (!defined $this_est_tax) {
1499         warn "no taxable sales found for inv#$invnum, tax item '$taxname'.\n";
1500         next INVOICE;
1501       }
1502       my $est_total = sum(values %$this_est_tax);
1503       if ( $est_total == 0 ) {
1504         # shouldn't happen
1505         warn "estimated tax on invoice #$invnum is zero.\n";
1506         next INVOICE;
1507       }
1508
1509       my $real_tax = $tax_item->setup;
1510       printf ("Distributing \$%.2f tax:\n", $real_tax);
1511       my $cents_remaining = $real_tax * 100; # for rounding error
1512       my @tax_links; # partial CBPTL hashrefs
1513       foreach my $taxclass (keys %taxdef_by_class) {
1514         my $taxdef = $taxdef_by_class{$taxclass};
1515         # these items already have "taxable" set to their charge amount
1516         # after applying any credits or exemptions
1517         my @items = @{ $taxable_items{$taxdef->taxnum} };
1518         my $subtotal = sum(map {$_->get('taxable')} @items);
1519         printf("\t$taxclass: %.2f\n", $this_est_tax->{$taxclass}/$est_total);
1520
1521         foreach my $nontax (@items) {
1522           my $my_tax_loc = $tax_loc{ $nontax->pkgnum };
1523           my $part = int($real_tax
1524                             # class allocation
1525                          * ($this_est_tax->{$taxclass}/$est_total)
1526                             # item allocation
1527                          * ($nontax->get('taxable'))/$subtotal
1528                             # convert to cents
1529                          * 100
1530                        );
1531           $cents_remaining -= $part;
1532           push @tax_links, {
1533             taxnum      => $taxdef->taxnum,
1534             pkgnum      => $nontax->pkgnum,
1535             locationnum => $my_tax_loc->locationnum,
1536             billpkgnum  => $nontax->billpkgnum,
1537             cents       => $part,
1538           };
1539         } #foreach $nontax
1540       } #foreach $taxclass
1541       # Distribute any leftover tax round-robin style, one cent at a time.
1542       my $i = 0;
1543       my $nlinks = scalar(@tax_links);
1544       if ( $nlinks ) {
1545         # ensure that it really is an integer
1546         $cents_remaining = sprintf('%.0f', $cents_remaining);
1547         while ($cents_remaining > 0) {
1548           $tax_links[$i % $nlinks]->{cents} += 1;
1549           $cents_remaining--;
1550           $i++;
1551         }
1552       } else {
1553         warn "Can't create tax links--no taxable items found.\n";
1554         next INVOICE;
1555       }
1556
1557       # Gather credit/payment applications so that we can link them
1558       # appropriately.
1559       my @unlinked = (
1560         qsearch( 'cust_credit_bill_pkg',
1561           { billpkgnum => $tax_item->billpkgnum, billpkgtaxlocationnum => '' }
1562         ),
1563         qsearch( 'cust_bill_pay_pkg',
1564           { billpkgnum => $tax_item->billpkgnum, billpkgtaxlocationnum => '' }
1565         )
1566       );
1567
1568       # grab the first one
1569       my $this_unlinked = shift @unlinked;
1570       my $unlinked_cents = int($this_unlinked->amount * 100) if $this_unlinked;
1571
1572       # Create tax links (yay!)
1573       printf("Creating %d tax links.\n",scalar(@tax_links));
1574       foreach (@tax_links) {
1575         my $link = FS::cust_bill_pkg_tax_location->new({
1576             billpkgnum  => $tax_item->billpkgnum,
1577             taxtype     => 'FS::cust_main_county',
1578             locationnum => $_->{locationnum},
1579             taxnum      => $_->{taxnum},
1580             pkgnum      => $_->{pkgnum},
1581             amount      => sprintf('%.2f', $_->{cents} / 100),
1582             taxable_billpkgnum => $_->{billpkgnum},
1583         });
1584         my $error = $link->insert;
1585         if ( $error ) {
1586           warn "Can't create tax link for inv#$invnum: $error\n";
1587           next INVOICE;
1588         }
1589
1590         my $link_cents = $_->{cents};
1591         # update/create subitem links
1592         #
1593         # If $this_unlinked is undef, then we've allocated all of the
1594         # credit/payment applications to the tax item.  If $link_cents is 0,
1595         # then we've applied credits/payments to all of this package fraction,
1596         # so go on to the next.
1597         while ($this_unlinked and $link_cents) {
1598           # apply as much as possible of $link_amount to this credit/payment
1599           # link
1600           my $apply_cents = min($link_cents, $unlinked_cents);
1601           $link_cents -= $apply_cents;
1602           $unlinked_cents -= $apply_cents;
1603           # $link_cents or $unlinked_cents or both are now zero
1604           $this_unlinked->set('amount' => sprintf('%.2f',$apply_cents/100));
1605           $this_unlinked->set('billpkgtaxlocationnum' => $link->billpkgtaxlocationnum);
1606           my $pkey = $this_unlinked->primary_key; #creditbillpkgnum or billpaypkgnum
1607           if ( $this_unlinked->$pkey ) {
1608             # then it's an existing link--replace it
1609             $error = $this_unlinked->replace;
1610           } else {
1611             $this_unlinked->insert;
1612           }
1613           # what do we do with errors at this stage?
1614           if ( $error ) {
1615             warn "Error creating tax application link: $error\n";
1616             next INVOICE; # for lack of a better idea
1617           }
1618
1619           if ( $unlinked_cents == 0 ) {
1620             # then we've allocated all of this payment/credit application,
1621             # so grab the next one
1622             $this_unlinked = shift @unlinked;
1623             $unlinked_cents = int($this_unlinked->amount * 100) if $this_unlinked;
1624           } elsif ( $link_cents == 0 ) {
1625             # then we've covered all of this package tax fraction, so split
1626             # off a new application from this one
1627             $this_unlinked = $this_unlinked->new({
1628                 $this_unlinked->hash,
1629                 $pkey     => '',
1630             });
1631             # $unlinked_cents is still what it is
1632           }
1633
1634         } #while $this_unlinked and $link_cents
1635       } #foreach (@tax_links)
1636     } #foreach $tax_item
1637
1638     $dbh->commit if $commit_each_invoice and $oldAutoCommit;
1639     $committed = 1;
1640
1641   } #foreach $invnum
1642   continue {
1643     if (!$committed) {
1644       $dbh->rollback if $oldAutoCommit;
1645       die "Upgrade halted.\n" unless $commit_each_invoice;
1646     }
1647   }
1648
1649   $dbh->commit if $oldAutoCommit and !$commit_each_invoice;
1650   '';
1651 }
1652
1653 sub _upgrade_data {
1654   # Create a queue job to run upgrade_tax_location from January 1, 2012 to
1655   # the present date.
1656   eval {
1657     use FS::queue;
1658     use Date::Parse 'str2time';
1659   };
1660   my $class = shift;
1661   my $upgrade = 'tax_location_2012';
1662   return if FS::upgrade_journal->is_done($upgrade);
1663   my $job = FS::queue->new({
1664       'job' => 'FS::cust_bill_pkg::upgrade_tax_location'
1665   });
1666   # call it kind of like a class method, not that it matters much
1667   $job->insert($class, 's' => str2time('2012-01-01'));
1668   # if there's a customer location upgrade queued also, wait for it to
1669   # finish
1670   my $location_job = qsearchs('queue', {
1671       job => 'FS::cust_main::Location::process_upgrade_location'
1672     });
1673   if ( $location_job ) {
1674     $job->depend_insert($location_job->jobnum);
1675   }
1676   # Then mark the upgrade as done, so that we don't queue the job twice
1677   # and somehow run two of them concurrently.
1678   FS::upgrade_journal->set_done($upgrade);
1679   # This upgrade now does the job of assigning taxable_billpkgnums to
1680   # cust_bill_pkg_tax_location, so set that task done also.
1681   FS::upgrade_journal->set_done('tax_location_taxable_billpkgnum');
1682 }
1683
1684 =back
1685
1686 =head1 BUGS
1687
1688 setup and recur shouldn't be separate fields.  There should be one "amount"
1689 field and a flag to tell you if it is a setup/one-time fee or a recurring fee.
1690
1691 A line item with both should really be two separate records (preserving
1692 sdate and edate for setup fees for recurring packages - that information may
1693 be valuable later).  Invoice generation (cust_main::bill), invoice printing
1694 (cust_bill), tax reports (report_tax.cgi) and line item reports
1695 (cust_bill_pkg.cgi) would need to be updated.
1696
1697 owed_setup and owed_recur could then be repaced by just owed, and
1698 cust_bill::open_cust_bill_pkg and
1699 cust_bill_ApplicationCommon::apply_to_lineitems could be simplified.
1700
1701 The upgrade procedure is pretty sketchy.
1702
1703 =head1 SEE ALSO
1704
1705 L<FS::Record>, L<FS::cust_bill>, L<FS::cust_pkg>, L<FS::cust_main>, schema.html
1706 from the base documentation.
1707
1708 =cut
1709
1710 1;
1711