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