FS/FS/cust_bill_pkg.pm

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