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