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