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