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