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