FS/FS/cust_bill_pkg.pm

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