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