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