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
1167   my $date_where = '';
1168   if ($opt{s}) {
1169     $date_where .= " AND cust_bill._date >= $opt{s}";
1170   }
1171   if ($opt{e}) {
1172     $date_where .= " AND cust_bill._date < $opt{e}";
1173   }
1174
1175   my $commit_each_invoice = 1 unless $opt{X};
1176
1177   # if an invoice has either of these kinds of objects, then it doesn't
1178   # need to be upgraded...probably
1179   my $sub_has_tax_link = 'SELECT 1 FROM cust_bill_pkg_tax_location'.
1180   ' JOIN cust_bill_pkg USING (billpkgnum)'.
1181   ' WHERE cust_bill_pkg.invnum = cust_bill.invnum';
1182   my $sub_has_exempt = 'SELECT 1 FROM cust_tax_exempt_pkg'.
1183   ' JOIN cust_bill_pkg USING (billpkgnum)'.
1184   ' WHERE cust_bill_pkg.invnum = cust_bill.invnum'.
1185   ' AND exempt_monthly IS NULL';
1186
1187   my $search = FS::Cursor->new({
1188       table => 'cust_bill',
1189       hashref => {},
1190       extra_sql => "WHERE NOT EXISTS($sub_has_tax_link) ".
1191                    "AND NOT EXISTS($sub_has_exempt) ".
1192                     $date_where,
1193   });
1194
1195 #print "Processing ".scalar(@invnums)." invoices...\n";
1196
1197   my $committed;
1198   INVOICE:
1199   while (my $cust_bill = $search->fetch) {
1200     my $invnum = $cust_bill->invnum;
1201     $committed = 0;
1202     print STDERR "Invoice #$invnum\n";
1203     my $pre = '';
1204     my %pkgpart_taxclass; # pkgpart => taxclass
1205     my %pkgpart_exempt_setup;
1206     my %pkgpart_exempt_recur;
1207     my $h_cust_bill = qsearchs('h_cust_bill',
1208       { invnum => $invnum,
1209         history_action => 'insert' });
1210     if (!$h_cust_bill) {
1211       warn "no insert record for invoice $invnum; skipped\n";
1212       #$date = $cust_bill->_date as a fallback?
1213       # We're trying to avoid using non-real dates (-d/-y invoice dates)
1214       # when looking up history records in other tables.
1215       next INVOICE;
1216     }
1217     my $custnum = $h_cust_bill->custnum;
1218
1219     # Determine the address corresponding to this tax region.
1220     # It's either the bill or ship address of the customer as of the
1221     # invoice date-of-insertion.  (Not necessarily the invoice date.)
1222     my $date = $h_cust_bill->history_date;
1223     my $h_cust_main = qsearchs('h_cust_main',
1224         { custnum => $custnum },
1225         FS::h_cust_main->sql_h_searchs($date)
1226       );
1227     if (!$h_cust_main ) {
1228       warn "no historical address for cust#".$h_cust_bill->custnum."; skipped\n";
1229       next INVOICE;
1230       # fallback to current $cust_main?  sounds dangerous.
1231     }
1232
1233     # This is a historical customer record, so it has a historical address.
1234     # If there's no cust_location matching this custnum and address (there
1235     # probably isn't), create one.
1236     $pre = 'ship_' if $use_ship and length($h_cust_main->get('ship_last'));
1237     my %hash = map { $_ => $h_cust_main->get($pre.$_) }
1238                   FS::cust_main->location_fields;
1239     # not really needed for this, and often result in duplicate locations
1240     delete @hash{qw(censustract censusyear latitude longitude coord_auto)};
1241
1242     $hash{custnum} = $h_cust_main->custnum;
1243     my $tax_loc = FS::cust_location->new(\%hash);
1244     my $error = $tax_loc->find_or_insert || $tax_loc->disable_if_unused;
1245     if ( $error ) {
1246       warn "couldn't create historical location record for cust#".
1247       $h_cust_main->custnum.": $error\n";
1248       next INVOICE;
1249     }
1250     my $exempt_cust = 1 if $h_cust_main->tax;
1251
1252     # Get any per-customer taxname exemptions that were in effect.
1253     my %exempt_cust_taxname = map {
1254       $_->taxname => 1
1255     } qsearch('h_cust_main_exemption', { 'custnum' => $custnum },
1256       FS::h_cust_main_exemption->sql_h_searchs($date)
1257     );
1258
1259     # classify line items
1260     my @tax_items;
1261     my %nontax_items; # taxclass => array of cust_bill_pkg
1262     foreach my $item ($h_cust_bill->cust_bill_pkg) {
1263       my $pkgnum = $item->pkgnum;
1264
1265       if ( $pkgnum == 0 ) {
1266
1267         push @tax_items, $item;
1268
1269       } else {
1270         # (pkgparts really shouldn't change, right?)
1271         my $h_cust_pkg = qsearchs('h_cust_pkg', { pkgnum => $pkgnum },
1272           FS::h_cust_pkg->sql_h_searchs($date)
1273         );
1274         if ( !$h_cust_pkg ) {
1275           warn "no historical package #".$item->pkgpart."; skipped\n";
1276           next INVOICE;
1277         }
1278         my $pkgpart = $h_cust_pkg->pkgpart;
1279
1280         if (!exists $pkgpart_taxclass{$pkgpart}) {
1281           my $h_part_pkg = qsearchs('h_part_pkg', { pkgpart => $pkgpart },
1282             FS::h_part_pkg->sql_h_searchs($date)
1283           );
1284           if ( !$h_part_pkg ) {
1285             warn "no historical package def #$pkgpart; skipped\n";
1286             next INVOICE;
1287           }
1288           $pkgpart_taxclass{$pkgpart} = $h_part_pkg->taxclass || '';
1289           $pkgpart_exempt_setup{$pkgpart} = 1 if $h_part_pkg->setuptax;
1290           $pkgpart_exempt_recur{$pkgpart} = 1 if $h_part_pkg->recurtax;
1291         }
1292
1293         # mark any exemptions that apply
1294         if ( $pkgpart_exempt_setup{$pkgpart} ) {
1295           $item->set('exempt_setup' => 1);
1296         }
1297
1298         if ( $pkgpart_exempt_recur{$pkgpart} ) {
1299           $item->set('exempt_recur' => 1);
1300         }
1301
1302         my $taxclass = $pkgpart_taxclass{ $pkgpart };
1303
1304         $nontax_items{$taxclass} ||= [];
1305         push @{ $nontax_items{$taxclass} }, $item;
1306       }
1307     }
1308     printf("%d tax items: \$%.2f\n", scalar(@tax_items), map {$_->setup} @tax_items)
1309       if @tax_items;
1310
1311     # Use a variation on the procedure in
1312     # FS::cust_main::Billing::_handle_taxes to identify taxes that apply
1313     # to this bill.
1314     my @loc_keys = qw( district city county state country );
1315     my %taxhash = map { $_ => $h_cust_main->get($pre.$_) } @loc_keys;
1316     my %taxdef_by_name; # by name, and then by taxclass
1317     my %est_tax; # by name, and then by taxclass
1318     my %taxable_items; # by taxnum, and then an array
1319
1320     foreach my $taxclass (keys %nontax_items) {
1321       my %myhash = %taxhash;
1322       my @elim = qw( district city county state );
1323       my @taxdefs; # because there may be several with different taxnames
1324       do {
1325         $myhash{taxclass} = $taxclass;
1326         @taxdefs = qsearch('cust_main_county', \%myhash);
1327         if ( !@taxdefs ) {
1328           $myhash{taxclass} = '';
1329           @taxdefs = qsearch('cust_main_county', \%myhash);
1330         }
1331         $myhash{ shift @elim } = '';
1332       } while scalar(@elim) and !@taxdefs;
1333
1334       print "Class '$taxclass': ". scalar(@{ $nontax_items{$taxclass} }).
1335             " items, ". scalar(@taxdefs)." tax defs found.\n";
1336       foreach my $taxdef (@taxdefs) {
1337         next if $taxdef->tax == 0;
1338         $taxdef_by_name{$taxdef->taxname}{$taxdef->taxclass} = $taxdef;
1339
1340         $taxable_items{$taxdef->taxnum} ||= [];
1341         foreach my $orig_item (@{ $nontax_items{$taxclass} }) {
1342           # clone the item so that taxdef-dependent changes don't
1343           # change it for other taxdefs
1344           my $item = FS::cust_bill_pkg->new({ $orig_item->hash });
1345
1346           # these flags are already set if the part_pkg declares itself exempt
1347           $item->set('exempt_setup' => 1) if $taxdef->setuptax;
1348           $item->set('exempt_recur' => 1) if $taxdef->recurtax;
1349
1350           my @new_exempt;
1351           my $taxable = $item->setup + $item->recur;
1352           # credits
1353           # h_cust_credit_bill_pkg?
1354           # NO.  Because if these exemptions HAD been created at the time of
1355           # billing, and then a credit applied later, the exemption would
1356           # have been adjusted by the amount of the credit.  So we adjust
1357           # the taxable amount before creating the exemption.
1358           # But don't deduct the credit from taxable, because the tax was
1359           # calculated before the credit was applied.
1360           foreach my $f (qw(setup recur)) {
1361             my $credited = FS::Record->scalar_sql(
1362               "SELECT SUM(amount) FROM cust_credit_bill_pkg ".
1363               "WHERE billpkgnum = ? AND setuprecur = ?",
1364               $item->billpkgnum,
1365               $f
1366             );
1367             $item->set($f, $item->get($f) - $credited) if $credited;
1368           }
1369           my $existing_exempt = FS::Record->scalar_sql(
1370             "SELECT SUM(amount) FROM cust_tax_exempt_pkg WHERE ".
1371             "billpkgnum = ? AND taxnum = ?",
1372             $item->billpkgnum, $taxdef->taxnum
1373           ) || 0;
1374           $taxable -= $existing_exempt;
1375
1376           if ( $taxable and $exempt_cust ) {
1377             push @new_exempt, { exempt_cust => 'Y',  amount => $taxable };
1378             $taxable = 0;
1379           }
1380           if ( $taxable and $exempt_cust_taxname{$taxdef->taxname} ){
1381             push @new_exempt, { exempt_cust_taxname => 'Y', amount => $taxable };
1382             $taxable = 0;
1383           }
1384           if ( $taxable and $item->exempt_setup ) {
1385             push @new_exempt, { exempt_setup => 'Y', amount => $item->setup };
1386             $taxable -= $item->setup;
1387           }
1388           if ( $taxable and $item->exempt_recur ) {
1389             push @new_exempt, { exempt_recur => 'Y', amount => $item->recur };
1390             $taxable -= $item->recur;
1391           }
1392
1393           $item->set('taxable' => $taxable);
1394           push @{ $taxable_items{$taxdef->taxnum} }, $item
1395             if $taxable > 0;
1396
1397           # estimate the amount of tax (this is necessary because different
1398           # taxdefs with the same taxname may have different tax rates)
1399           # and sum that for each taxname/taxclass combination
1400           # (in cents)
1401           $est_tax{$taxdef->taxname} ||= {};
1402           $est_tax{$taxdef->taxname}{$taxdef->taxclass} ||= 0;
1403           $est_tax{$taxdef->taxname}{$taxdef->taxclass} +=
1404             $taxable * $taxdef->tax;
1405
1406           foreach (@new_exempt) {
1407             next if $_->{amount} == 0;
1408             my $cust_tax_exempt_pkg = FS::cust_tax_exempt_pkg->new({
1409                 %$_,
1410                 billpkgnum  => $item->billpkgnum,
1411                 taxnum      => $taxdef->taxnum,
1412               });
1413             my $error = $cust_tax_exempt_pkg->insert;
1414             if ($error) {
1415               my $pkgnum = $item->pkgnum;
1416               warn "error creating tax exemption for inv$invnum pkg$pkgnum:".
1417                 "\n$error\n\n";
1418               next INVOICE;
1419             }
1420           } #foreach @new_exempt
1421         } #foreach $item
1422       } #foreach $taxdef
1423     } #foreach $taxclass
1424
1425     # Now go through the billed taxes and match them up with the line items.
1426     TAX_ITEM: foreach my $tax_item ( @tax_items )
1427     {
1428       my $taxname = $tax_item->itemdesc;
1429       $taxname = '' if $taxname eq 'Tax';
1430
1431       if ( !exists( $taxdef_by_name{$taxname} ) ) {
1432         # then we didn't find any applicable taxes with this name
1433         warn "no definition found for tax item '$taxname'.\n".
1434           '('.join(' ', @hash{qw(country state county city district)}).")\n";
1435         # possibly all of these should be "next TAX_ITEM", but whole invoices
1436         # are transaction protected and we can go back and retry them.
1437         next INVOICE;
1438       }
1439       # classname => cust_main_county
1440       my %taxdef_by_class = %{ $taxdef_by_name{$taxname} };
1441
1442       # Divide the tax item among taxclasses, if necessary
1443       # classname => estimated tax amount
1444       my $this_est_tax = $est_tax{$taxname};
1445       if (!defined $this_est_tax) {
1446         warn "no taxable sales found for inv#$invnum, tax item '$taxname'.\n";
1447         next INVOICE;
1448       }
1449       my $est_total = sum(values %$this_est_tax);
1450       if ( $est_total == 0 ) {
1451         # shouldn't happen
1452         warn "estimated tax on invoice #$invnum is zero.\n";
1453         next INVOICE;
1454       }
1455
1456       my $real_tax = $tax_item->setup;
1457       printf ("Distributing \$%.2f tax:\n", $real_tax);
1458       my $cents_remaining = $real_tax * 100; # for rounding error
1459       my @tax_links; # partial CBPTL hashrefs
1460       foreach my $taxclass (keys %taxdef_by_class) {
1461         my $taxdef = $taxdef_by_class{$taxclass};
1462         # these items already have "taxable" set to their charge amount
1463         # after applying any credits or exemptions
1464         my @items = @{ $taxable_items{$taxdef->taxnum} };
1465         my $subtotal = sum(map {$_->get('taxable')} @items);
1466         printf("\t$taxclass: %.2f\n", $this_est_tax->{$taxclass}/$est_total);
1467
1468         foreach my $nontax (@items) {
1469           my $part = int($real_tax
1470                             # class allocation
1471                          * ($this_est_tax->{$taxclass}/$est_total)
1472                             # item allocation
1473                          * ($nontax->get('taxable'))/$subtotal
1474                             # convert to cents
1475                          * 100
1476                        );
1477           $cents_remaining -= $part;
1478           push @tax_links, {
1479             taxnum      => $taxdef->taxnum,
1480             pkgnum      => $nontax->pkgnum,
1481             billpkgnum  => $nontax->billpkgnum,
1482             cents       => $part,
1483           };
1484         } #foreach $nontax
1485       } #foreach $taxclass
1486       # Distribute any leftover tax round-robin style, one cent at a time.
1487       my $i = 0;
1488       my $nlinks = scalar(@tax_links);
1489       if ( $nlinks ) {
1490         # ensure that it really is an integer
1491         $cents_remaining = sprintf('%.0f', $cents_remaining);
1492         while ($cents_remaining > 0) {
1493           $tax_links[$i % $nlinks]->{cents} += 1;
1494           $cents_remaining--;
1495           $i++;
1496         }
1497       } else {
1498         warn "Can't create tax links--no taxable items found.\n";
1499         next INVOICE;
1500       }
1501
1502       # Gather credit/payment applications so that we can link them
1503       # appropriately.
1504       my @unlinked = (
1505         qsearch( 'cust_credit_bill_pkg',
1506           { billpkgnum => $tax_item->billpkgnum, billpkgtaxlocationnum => '' }
1507         ),
1508         qsearch( 'cust_bill_pay_pkg',
1509           { billpkgnum => $tax_item->billpkgnum, billpkgtaxlocationnum => '' }
1510         )
1511       );
1512
1513       # grab the first one
1514       my $this_unlinked = shift @unlinked;
1515       my $unlinked_cents = int($this_unlinked->amount * 100) if $this_unlinked;
1516
1517       # Create tax links (yay!)
1518       printf("Creating %d tax links.\n",scalar(@tax_links));
1519       foreach (@tax_links) {
1520         my $link = FS::cust_bill_pkg_tax_location->new({
1521             billpkgnum  => $tax_item->billpkgnum,
1522             taxtype     => 'FS::cust_main_county',
1523             locationnum => $tax_loc->locationnum,
1524             taxnum      => $_->{taxnum},
1525             pkgnum      => $_->{pkgnum},
1526             amount      => sprintf('%.2f', $_->{cents} / 100),
1527             taxable_billpkgnum => $_->{billpkgnum},
1528         });
1529         my $error = $link->insert;
1530         if ( $error ) {
1531           warn "Can't create tax link for inv#$invnum: $error\n";
1532           next INVOICE;
1533         }
1534
1535         my $link_cents = $_->{cents};
1536         # update/create subitem links
1537         #
1538         # If $this_unlinked is undef, then we've allocated all of the
1539         # credit/payment applications to the tax item.  If $link_cents is 0,
1540         # then we've applied credits/payments to all of this package fraction,
1541         # so go on to the next.
1542         while ($this_unlinked and $link_cents) {
1543           # apply as much as possible of $link_amount to this credit/payment
1544           # link
1545           my $apply_cents = min($link_cents, $unlinked_cents);
1546           $link_cents -= $apply_cents;
1547           $unlinked_cents -= $apply_cents;
1548           # $link_cents or $unlinked_cents or both are now zero
1549           $this_unlinked->set('amount' => sprintf('%.2f',$apply_cents/100));
1550           $this_unlinked->set('billpkgtaxlocationnum' => $link->billpkgtaxlocationnum);
1551           my $pkey = $this_unlinked->primary_key; #creditbillpkgnum or billpaypkgnum
1552           if ( $this_unlinked->$pkey ) {
1553             # then it's an existing link--replace it
1554             $error = $this_unlinked->replace;
1555           } else {
1556             $this_unlinked->insert;
1557           }
1558           # what do we do with errors at this stage?
1559           if ( $error ) {
1560             warn "Error creating tax application link: $error\n";
1561             next INVOICE; # for lack of a better idea
1562           }
1563
1564           if ( $unlinked_cents == 0 ) {
1565             # then we've allocated all of this payment/credit application,
1566             # so grab the next one
1567             $this_unlinked = shift @unlinked;
1568             $unlinked_cents = int($this_unlinked->amount * 100) if $this_unlinked;
1569           } elsif ( $link_cents == 0 ) {
1570             # then we've covered all of this package tax fraction, so split
1571             # off a new application from this one
1572             $this_unlinked = $this_unlinked->new({
1573                 $this_unlinked->hash,
1574                 $pkey     => '',
1575             });
1576             # $unlinked_cents is still what it is
1577           }
1578
1579         } #while $this_unlinked and $link_cents
1580       } #foreach (@tax_links)
1581     } #foreach $tax_item
1582
1583     $dbh->commit if $commit_each_invoice and $oldAutoCommit;
1584     $committed = 1;
1585
1586   } #foreach $invnum
1587   continue {
1588     if (!$committed) {
1589       $dbh->rollback if $oldAutoCommit;
1590       die "Upgrade halted.\n" unless $commit_each_invoice;
1591     }
1592   }
1593
1594   $dbh->commit if $oldAutoCommit and !$commit_each_invoice;
1595   '';
1596 }
1597
1598 sub _upgrade_data {
1599   # Create a queue job to run upgrade_tax_location from January 1, 2012 to
1600   # the present date.
1601   eval {
1602     use FS::queue;
1603     use Date::Parse 'str2time';
1604   };
1605   my $class = shift;
1606   my $upgrade = 'tax_location_2012';
1607   return if FS::upgrade_journal->is_done($upgrade);
1608   my $job = FS::queue->new({
1609       'job' => 'FS::cust_bill_pkg::upgrade_tax_location'
1610   });
1611   # call it kind of like a class method, not that it matters much
1612   $job->insert($class, 's' => str2time('2012-01-01'));
1613   # if there's a customer location upgrade queued also, wait for it to
1614   # finish
1615   my $location_job = qsearchs('queue', {
1616       job => 'FS::cust_main::Location::process_upgrade_location'
1617     });
1618   if ( $location_job ) {
1619     $job->depend_insert($location_job->jobnum);
1620   }
1621   # Then mark the upgrade as done, so that we don't queue the job twice
1622   # and somehow run two of them concurrently.
1623   FS::upgrade_journal->set_done($upgrade);
1624   # This upgrade now does the job of assigning taxable_billpkgnums to
1625   # cust_bill_pkg_tax_location, so set that task done also.
1626   FS::upgrade_journal->set_done('tax_location_taxable_billpkgnum');
1627 }
1628
1629 =back
1630
1631 =head1 BUGS
1632
1633 setup and recur shouldn't be separate fields.  There should be one "amount"
1634 field and a flag to tell you if it is a setup/one-time fee or a recurring fee.
1635
1636 A line item with both should really be two separate records (preserving
1637 sdate and edate for setup fees for recurring packages - that information may
1638 be valuable later).  Invoice generation (cust_main::bill), invoice printing
1639 (cust_bill), tax reports (report_tax.cgi) and line item reports
1640 (cust_bill_pkg.cgi) would need to be updated.
1641
1642 owed_setup and owed_recur could then be repaced by just owed, and
1643 cust_bill::open_cust_bill_pkg and
1644 cust_bill_ApplicationCommon::apply_to_lineitems could be simplified.
1645
1646 The upgrade procedure is pretty sketchy.
1647
1648 =head1 SEE ALSO
1649
1650 L<FS::Record>, L<FS::cust_bill>, L<FS::cust_pkg>, L<FS::cust_main>, schema.html
1651 from the base documentation.
1652
1653 =cut
1654
1655 1;
1656