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