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