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