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