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 = FS::cust_location->new_or_existing(\%hash);
1108     if ( !$tax_loc->locationnum ) {
1109       $tax_loc->disabled('Y');
1110       my $error = $tax_loc->insert;
1111       if ( $error ) {
1112         warn "couldn't create historical location record for cust#".
1113         $h_cust_main->custnum.": $error\n";
1114         next INVOICE;
1115       }
1116     }
1117     my $exempt_cust = 1 if $h_cust_main->tax;
1118
1119     # Get any per-customer taxname exemptions that were in effect.
1120     my %exempt_cust_taxname = map {
1121       $_->taxname => 1
1122     } qsearch('h_cust_main_exemption', { 'custnum' => $custnum },
1123       FS::h_cust_main_exemption->sql_h_searchs($date)
1124     );
1125
1126     # classify line items
1127     my @tax_items;
1128     my %nontax_items; # taxclass => array of cust_bill_pkg
1129     foreach my $item ($h_cust_bill->cust_bill_pkg) {
1130       my $pkgnum = $item->pkgnum;
1131
1132       if ( $pkgnum == 0 ) {
1133
1134         push @tax_items, $item;
1135
1136       } else {
1137         # (pkgparts really shouldn't change, right?)
1138         my $h_cust_pkg = qsearchs('h_cust_pkg', { pkgnum => $pkgnum },
1139           FS::h_cust_pkg->sql_h_searchs($date)
1140         );
1141         if ( !$h_cust_pkg ) {
1142           warn "no historical package #".$item->pkgpart."; skipped\n";
1143           next INVOICE;
1144         }
1145         my $pkgpart = $h_cust_pkg->pkgpart;
1146
1147         if (!exists $pkgpart_taxclass{$pkgpart}) {
1148           my $h_part_pkg = qsearchs('h_part_pkg', { pkgpart => $pkgpart },
1149             FS::h_part_pkg->sql_h_searchs($date)
1150           );
1151           if ( !$h_part_pkg ) {
1152             warn "no historical package def #$pkgpart; skipped\n";
1153             next INVOICE;
1154           }
1155           $pkgpart_taxclass{$pkgpart} = $h_part_pkg->taxclass || '';
1156           $pkgpart_exempt_setup{$pkgpart} = 1 if $h_part_pkg->setuptax;
1157           $pkgpart_exempt_recur{$pkgpart} = 1 if $h_part_pkg->recurtax;
1158         }
1159
1160         # mark any exemptions that apply
1161         if ( $pkgpart_exempt_setup{$pkgpart} ) {
1162           $item->set('exempt_setup' => 1);
1163         }
1164
1165         if ( $pkgpart_exempt_recur{$pkgpart} ) {
1166           $item->set('exempt_recur' => 1);
1167         }
1168
1169         my $taxclass = $pkgpart_taxclass{ $pkgpart };
1170
1171         $nontax_items{$taxclass} ||= [];
1172         push @{ $nontax_items{$taxclass} }, $item;
1173       }
1174     }
1175     printf("%d tax items: \$%.2f\n", scalar(@tax_items), map {$_->setup} @tax_items)
1176       if @tax_items;
1177
1178     # Use a variation on the procedure in
1179     # FS::cust_main::Billing::_handle_taxes to identify taxes that apply
1180     # to this bill.
1181     my @loc_keys = qw( district city county state country );
1182     my %taxhash = map { $_ => $h_cust_main->get($pre.$_) } @loc_keys;
1183     my %taxdef_by_name; # by name, and then by taxclass
1184     my %est_tax; # by name, and then by taxclass
1185     my %taxable_items; # by taxnum, and then an array
1186
1187     foreach my $taxclass (keys %nontax_items) {
1188       my %myhash = %taxhash;
1189       my @elim = qw( district city county state );
1190       my @taxdefs; # because there may be several with different taxnames
1191       do {
1192         $myhash{taxclass} = $taxclass;
1193         @taxdefs = qsearch('cust_main_county', \%myhash);
1194         if ( !@taxdefs ) {
1195           $myhash{taxclass} = '';
1196           @taxdefs = qsearch('cust_main_county', \%myhash);
1197         }
1198         $myhash{ shift @elim } = '';
1199       } while scalar(@elim) and !@taxdefs;
1200
1201       print "Class '$taxclass': ". scalar(@{ $nontax_items{$taxclass} }).
1202             " items, ". scalar(@taxdefs)." tax defs found.\n";
1203       foreach my $taxdef (@taxdefs) {
1204         next if $taxdef->tax == 0;
1205         $taxdef_by_name{$taxdef->taxname}{$taxdef->taxclass} = $taxdef;
1206
1207         $taxable_items{$taxdef->taxnum} ||= [];
1208         foreach my $orig_item (@{ $nontax_items{$taxclass} }) {
1209           # clone the item so that taxdef-dependent changes don't
1210           # change it for other taxdefs
1211           my $item = FS::cust_bill_pkg->new({ $orig_item->hash });
1212
1213           # these flags are already set if the part_pkg declares itself exempt
1214           $item->set('exempt_setup' => 1) if $taxdef->setuptax;
1215           $item->set('exempt_recur' => 1) if $taxdef->recurtax;
1216
1217           my @new_exempt;
1218           my $taxable = $item->setup + $item->recur;
1219           # credits
1220           # h_cust_credit_bill_pkg?
1221           # NO.  Because if these exemptions HAD been created at the time of
1222           # billing, and then a credit applied later, the exemption would
1223           # have been adjusted by the amount of the credit.  So we adjust
1224           # the taxable amount before creating the exemption.
1225           # But don't deduct the credit from taxable, because the tax was
1226           # calculated before the credit was applied.
1227           foreach my $f (qw(setup recur)) {
1228             my $credited = FS::Record->scalar_sql(
1229               "SELECT SUM(amount) FROM cust_credit_bill_pkg ".
1230               "WHERE billpkgnum = ? AND setuprecur = ?",
1231               $item->billpkgnum,
1232               $f
1233             );
1234             $item->set($f, $item->get($f) - $credited) if $credited;
1235           }
1236           my $existing_exempt = FS::Record->scalar_sql(
1237             "SELECT SUM(amount) FROM cust_tax_exempt_pkg WHERE ".
1238             "billpkgnum = ? AND taxnum = ?",
1239             $item->billpkgnum, $taxdef->taxnum
1240           ) || 0;
1241           $taxable -= $existing_exempt;
1242
1243           if ( $taxable and $exempt_cust ) {
1244             push @new_exempt, { exempt_cust => 'Y',  amount => $taxable };
1245             $taxable = 0;
1246           }
1247           if ( $taxable and $exempt_cust_taxname{$taxdef->taxname} ){
1248             push @new_exempt, { exempt_cust_taxname => 'Y', amount => $taxable };
1249             $taxable = 0;
1250           }
1251           if ( $taxable and $item->exempt_setup ) {
1252             push @new_exempt, { exempt_setup => 'Y', amount => $item->setup };
1253             $taxable -= $item->setup;
1254           }
1255           if ( $taxable and $item->exempt_recur ) {
1256             push @new_exempt, { exempt_recur => 'Y', amount => $item->recur };
1257             $taxable -= $item->recur;
1258           }
1259
1260           $item->set('taxable' => $taxable);
1261           push @{ $taxable_items{$taxdef->taxnum} }, $item
1262             if $taxable > 0;
1263
1264           # estimate the amount of tax (this is necessary because different
1265           # taxdefs with the same taxname may have different tax rates)
1266           # and sum that for each taxname/taxclass combination
1267           # (in cents)
1268           $est_tax{$taxdef->taxname} ||= {};
1269           $est_tax{$taxdef->taxname}{$taxdef->taxclass} ||= 0;
1270           $est_tax{$taxdef->taxname}{$taxdef->taxclass} +=
1271             $taxable * $taxdef->tax;
1272
1273           foreach (@new_exempt) {
1274             next if $_->{amount} == 0;
1275             my $cust_tax_exempt_pkg = FS::cust_tax_exempt_pkg->new({
1276                 %$_,
1277                 billpkgnum  => $item->billpkgnum,
1278                 taxnum      => $taxdef->taxnum,
1279               });
1280             my $error = $cust_tax_exempt_pkg->insert;
1281             if ($error) {
1282               my $pkgnum = $item->pkgnum;
1283               warn "error creating tax exemption for inv$invnum pkg$pkgnum:".
1284                 "\n$error\n\n";
1285               next INVOICE;
1286             }
1287           } #foreach @new_exempt
1288         } #foreach $item
1289       } #foreach $taxdef
1290     } #foreach $taxclass
1291
1292     # Now go through the billed taxes and match them up with the line items.
1293     TAX_ITEM: foreach my $tax_item ( @tax_items )
1294     {
1295       my $taxname = $tax_item->itemdesc;
1296       $taxname = '' if $taxname eq 'Tax';
1297
1298       if ( !exists( $taxdef_by_name{$taxname} ) ) {
1299         # then we didn't find any applicable taxes with this name
1300         warn "no definition found for tax item '$taxname'.\n".
1301           '('.join(' ', @hash{qw(country state county city district)}).")\n";
1302         # possibly all of these should be "next TAX_ITEM", but whole invoices
1303         # are transaction protected and we can go back and retry them.
1304         next INVOICE;
1305       }
1306       # classname => cust_main_county
1307       my %taxdef_by_class = %{ $taxdef_by_name{$taxname} };
1308
1309       # Divide the tax item among taxclasses, if necessary
1310       # classname => estimated tax amount
1311       my $this_est_tax = $est_tax{$taxname};
1312       if (!defined $this_est_tax) {
1313         warn "no taxable sales found for inv#$invnum, tax item '$taxname'.\n";
1314         next INVOICE;
1315       }
1316       my $est_total = sum(values %$this_est_tax);
1317       if ( $est_total == 0 ) {
1318         # shouldn't happen
1319         warn "estimated tax on invoice #$invnum is zero.\n";
1320         next INVOICE;
1321       }
1322
1323       my $real_tax = $tax_item->setup;
1324       printf ("Distributing \$%.2f tax:\n", $real_tax);
1325       my $cents_remaining = $real_tax * 100; # for rounding error
1326       my @tax_links; # partial CBPTL hashrefs
1327       foreach my $taxclass (keys %taxdef_by_class) {
1328         my $taxdef = $taxdef_by_class{$taxclass};
1329         # these items already have "taxable" set to their charge amount
1330         # after applying any credits or exemptions
1331         my @items = @{ $taxable_items{$taxdef->taxnum} };
1332         my $subtotal = sum(map {$_->get('taxable')} @items);
1333         printf("\t$taxclass: %.2f\n", $this_est_tax->{$taxclass}/$est_total);
1334
1335         foreach my $nontax (@items) {
1336           my $part = int($real_tax
1337                             # class allocation
1338                          * ($this_est_tax->{$taxclass}/$est_total)
1339                             # item allocation
1340                          * ($nontax->get('taxable'))/$subtotal
1341                             # convert to cents
1342                          * 100
1343                        );
1344           $cents_remaining -= $part;
1345           push @tax_links, {
1346             taxnum      => $taxdef->taxnum,
1347             pkgnum      => $nontax->pkgnum,
1348             billpkgnum  => $nontax->billpkgnum,
1349             cents       => $part,
1350           };
1351         } #foreach $nontax
1352       } #foreach $taxclass
1353       # Distribute any leftover tax round-robin style, one cent at a time.
1354       my $i = 0;
1355       my $nlinks = scalar(@tax_links);
1356       if ( $nlinks ) {
1357         while (int($cents_remaining) > 0) {
1358           $tax_links[$i % $nlinks]->{cents} += 1;
1359           $cents_remaining--;
1360           $i++;
1361         }
1362       } else {
1363         warn "Can't create tax links--no taxable items found.\n";
1364         next INVOICE;
1365       }
1366
1367       # Gather credit/payment applications so that we can link them
1368       # appropriately.
1369       my @unlinked = (
1370         qsearch( 'cust_credit_bill_pkg',
1371           { billpkgnum => $tax_item->billpkgnum, billpkgtaxlocationnum => '' }
1372         ),
1373         qsearch( 'cust_bill_pay_pkg',
1374           { billpkgnum => $tax_item->billpkgnum, billpkgtaxlocationnum => '' }
1375         )
1376       );
1377
1378       # grab the first one
1379       my $this_unlinked = shift @unlinked;
1380       my $unlinked_cents = int($this_unlinked->amount * 100) if $this_unlinked;
1381
1382       # Create tax links (yay!)
1383       printf("Creating %d tax links.\n",scalar(@tax_links));
1384       foreach (@tax_links) {
1385         my $link = FS::cust_bill_pkg_tax_location->new({
1386             billpkgnum  => $tax_item->billpkgnum,
1387             taxtype     => 'FS::cust_main_county',
1388             locationnum => $tax_loc->locationnum,
1389             taxnum      => $_->{taxnum},
1390             pkgnum      => $_->{pkgnum},
1391             amount      => sprintf('%.2f', $_->{cents} / 100),
1392             taxable_billpkgnum => $_->{billpkgnum},
1393         });
1394         my $error = $link->insert;
1395         if ( $error ) {
1396           warn "Can't create tax link for inv#$invnum: $error\n";
1397           next INVOICE;
1398         }
1399
1400         my $link_cents = $_->{cents};
1401         # update/create subitem links
1402         #
1403         # If $this_unlinked is undef, then we've allocated all of the
1404         # credit/payment applications to the tax item.  If $link_cents is 0,
1405         # then we've applied credits/payments to all of this package fraction,
1406         # so go on to the next.
1407         while ($this_unlinked and $link_cents) {
1408           # apply as much as possible of $link_amount to this credit/payment
1409           # link
1410           my $apply_cents = min($link_cents, $unlinked_cents);
1411           $link_cents -= $apply_cents;
1412           $unlinked_cents -= $apply_cents;
1413           # $link_cents or $unlinked_cents or both are now zero
1414           $this_unlinked->set('amount' => sprintf('%.2f',$apply_cents/100));
1415           $this_unlinked->set('billpkgtaxlocationnum' => $link->billpkgtaxlocationnum);
1416           my $pkey = $this_unlinked->primary_key; #creditbillpkgnum or billpaypkgnum
1417           if ( $this_unlinked->$pkey ) {
1418             # then it's an existing link--replace it
1419             $error = $this_unlinked->replace;
1420           } else {
1421             $this_unlinked->insert;
1422           }
1423           # what do we do with errors at this stage?
1424           if ( $error ) {
1425             warn "Error creating tax application link: $error\n";
1426             next INVOICE; # for lack of a better idea
1427           }
1428
1429           if ( $unlinked_cents == 0 ) {
1430             # then we've allocated all of this payment/credit application,
1431             # so grab the next one
1432             $this_unlinked = shift @unlinked;
1433             $unlinked_cents = int($this_unlinked->amount * 100) if $this_unlinked;
1434           } elsif ( $link_cents == 0 ) {
1435             # then we've covered all of this package tax fraction, so split
1436             # off a new application from this one
1437             $this_unlinked = $this_unlinked->new({
1438                 $this_unlinked->hash,
1439                 $pkey     => '',
1440             });
1441             # $unlinked_cents is still what it is
1442           }
1443
1444         } #while $this_unlinked and $link_cents
1445       } #foreach (@tax_links)
1446     } #foreach $tax_item
1447
1448     $dbh->commit if $commit_each_invoice and $oldAutoCommit;
1449     $committed = 1;
1450
1451   } #foreach $invnum
1452   continue {
1453     if (!$committed) {
1454       $dbh->rollback if $oldAutoCommit;
1455       die "Upgrade halted.\n" unless $commit_each_invoice;
1456     }
1457   }
1458
1459   $dbh->commit if $oldAutoCommit and !$commit_each_invoice;
1460   '';
1461 }
1462
1463 sub _upgrade_data {
1464   # Create a queue job to run upgrade_tax_location from January 1, 2012 to
1465   # the present date.
1466   eval {
1467     use FS::queue;
1468     use Date::Parse 'str2time';
1469   };
1470   my $class = shift;
1471   my $upgrade = 'tax_location_2012';
1472   return if FS::upgrade_journal->is_done($upgrade);
1473   my $job = FS::queue->new({
1474       'job' => 'FS::cust_bill_pkg::upgrade_tax_location'
1475   });
1476   # call it kind of like a class method, not that it matters much
1477   $job->insert($class, 's' => str2time('2012-01-01'));
1478   # Then mark the upgrade as done, so that we don't queue the job twice
1479   # and somehow run two of them concurrently.
1480   FS::upgrade_journal->set_done($upgrade);
1481   # This upgrade now does the job of assigning taxable_billpkgnums to
1482   # cust_bill_pkg_tax_location, so set that task done also.
1483   FS::upgrade_journal->set_done('tax_location_taxable_billpkgnum');
1484 }
1485
1486 =back
1487
1488 =head1 BUGS
1489
1490 setup and recur shouldn't be separate fields.  There should be one "amount"
1491 field and a flag to tell you if it is a setup/one-time fee or a recurring fee.
1492
1493 A line item with both should really be two separate records (preserving
1494 sdate and edate for setup fees for recurring packages - that information may
1495 be valuable later).  Invoice generation (cust_main::bill), invoice printing
1496 (cust_bill), tax reports (report_tax.cgi) and line item reports
1497 (cust_bill_pkg.cgi) would need to be updated.
1498
1499 owed_setup and owed_recur could then be repaced by just owed, and
1500 cust_bill::open_cust_bill_pkg and
1501 cust_bill_ApplicationCommon::apply_to_lineitems could be simplified.
1502
1503 The upgrade procedure is pretty sketchy.
1504
1505 =head1 SEE ALSO
1506
1507 L<FS::Record>, L<FS::cust_bill>, L<FS::cust_pkg>, L<FS::cust_main>, schema.html
1508 from the base documentation.
1509
1510 =cut
1511
1512 1;
1513