FS/FS/cust_bill_pkg.pm

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