FS/FS/cust_bill_pkg.pm

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