FS/FS/cust_bill_pkg.pm

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