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