FS/FS/cust_bill_pkg.pm

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