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