FS/FS/cust_bill_pkg.pm

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