FS/FS/cust_bill_pkg.pm

   1 package FS::cust_bill_pkg;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG $me );
   5 use Carp;
   6 use Text::CSV_XS;
   7 use FS::Record qw( qsearch qsearchs dbdef dbh );
   8 use FS::cust_main_Mixin;
   9 use FS::cust_pkg;
  10 use FS::part_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
  22 @ISA = qw( FS::cust_main_Mixin FS::Record );
  23
  24 $DEBUG = 0;
  25 $me = '[FS::cust_bill_pkg]';
  26
  27 =head1 NAME
  28
  29 FS::cust_bill_pkg - Object methods for cust_bill_pkg records
  30
  31 =head1 SYNOPSIS
  32
  33   use FS::cust_bill_pkg;
  34
  35   $record = new FS::cust_bill_pkg \%hash;
  36   $record = new FS::cust_bill_pkg { 'column' => 'value' };
  37
  38   $error = $record->insert;
  39
  40   $error = $record->check;
  41
  42 =head1 DESCRIPTION
  43
  44 An FS::cust_bill_pkg object represents an invoice line item.
  45 FS::cust_bill_pkg inherits from FS::Record.  The following fields are currently
  46 supported:
  47
  48 =over 4
  49
  50 =item billpkgnum
  51
  52 primary key
  53
  54 =item invnum
  55
  56 invoice (see L<FS::cust_bill>)
  57
  58 =item pkgnum
  59
  60 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)
  61
  62 =item pkgpart_override
  63
  64 optional package definition (see L<FS::part_pkg>) override
  65
  66 =item setup
  67
  68 setup fee
  69
  70 =item recur
  71
  72 recurring fee
  73
  74 =item sdate
  75
  76 starting date of recurring fee
  77
  78 =item edate
  79
  80 ending date of recurring fee
  81
  82 =item itemdesc
  83
  84 Line item description (overrides normal package description)
  85
  86 =item quantity
  87
  88 If not set, defaults to 1
  89
  90 =item unitsetup
  91
  92 If not set, defaults to setup
  93
  94 =item unitrecur
  95
  96 If not set, defaults to recur
  97
  98 =item hidden
  99
 100 If set to Y, indicates data should not appear as separate line item on invoice
 101
 102 =back
 103
 104 sdate and edate are specified as UNIX timestamps; see L<perlfunc/"time">.  Also
 105 see L<Time::Local> and L<Date::Parse> for conversion functions.
 106
 107 =head1 METHODS
 108
 109 =over 4
 110
 111 =item new HASHREF
 112
 113 Creates a new line item.  To add the line item to the database, see
 114 L<"insert">.  Line items are normally created by calling the bill method of a
 115 customer object (see L<FS::cust_main>).
 116
 117 =cut
 118
 119 sub table { 'cust_bill_pkg'; }
 120
 121 =item insert
 122
 123 Adds this line item to the database.  If there is an error, returns the error,
 124 otherwise returns false.
 125
 126 =cut
 127
 128 sub insert {
 129   my $self = shift;
 130
 131   local $SIG{HUP} = 'IGNORE';
 132   local $SIG{INT} = 'IGNORE';
 133   local $SIG{QUIT} = 'IGNORE';
 134   local $SIG{TERM} = 'IGNORE';
 135   local $SIG{TSTP} = 'IGNORE';
 136   local $SIG{PIPE} = 'IGNORE';
 137
 138   my $oldAutoCommit = $FS::UID::AutoCommit;
 139   local $FS::UID::AutoCommit = 0;
 140   my $dbh = dbh;
 141
 142   my $error = $self->SUPER::insert;
 143   if ( $error ) {
 144     $dbh->rollback if $oldAutoCommit;
 145     return $error;
 146   }
 147
 148   if ( $self->get('details') ) {
 149     foreach my $detail ( @{$self->get('details')} ) {
 150       my %hash = ();
 151       if ( ref($detail) ) {
 152         if ( ref($detail) eq 'ARRAY' ) {
 153           #carp "this way sucks, use a hash"; #but more useful/friendly
 154           $hash{'format'}      = $detail->[0];
 155           $hash{'detail'}      = $detail->[1];
 156           $hash{'amount'}      = $detail->[2];
 157           $hash{'classnum'}    = $detail->[3];
 158           $hash{'phonenum'}    = $detail->[4];
 159           $hash{'accountcode'} = $detail->[5];
 160           $hash{'startdate'}   = $detail->[6];
 161           $hash{'duration'}    = $detail->[7];
 162           $hash{'regionname'}  = $detail->[8];
 163         } elsif ( ref($detail) eq 'HASH' ) {
 164           %hash = %$detail;
 165         } else {
 166           die "unknow detail type ". ref($detail);
 167         }
 168       } else {
 169         $hash{'detail'} = $detail;
 170       }
 171       $hash{'billpkgnum'} = $self->billpkgnum;
 172       my $cust_bill_pkg_detail = new FS::cust_bill_pkg_detail \%hash;
 173       $error = $cust_bill_pkg_detail->insert;
 174       if ( $error ) {
 175         $dbh->rollback if $oldAutoCommit;
 176         return "error inserting cust_bill_pkg_detail: $error";
 177       }
 178     }
 179   }
 180
 181   if ( $self->get('display') ) {
 182     foreach my $cust_bill_pkg_display ( @{ $self->get('display') } ) {
 183       $cust_bill_pkg_display->billpkgnum($self->billpkgnum);
 184       $error = $cust_bill_pkg_display->insert;
 185       if ( $error ) {
 186         $dbh->rollback if $oldAutoCommit;
 187         return "error inserting cust_bill_pkg_display: $error";
 188       }
 189     }
 190   }
 191
 192   if ( $self->get('discounts') ) {
 193     foreach my $cust_bill_pkg_discount ( @{$self->get('discounts')} ) {
 194       $cust_bill_pkg_discount->billpkgnum($self->billpkgnum);
 195       $error = $cust_bill_pkg_discount->insert;
 196       if ( $error ) {
 197         $dbh->rollback if $oldAutoCommit;
 198         return "error inserting cust_bill_pkg_discount: $error";
 199       }
 200     }
 201   }
 202
 203   if ( $self->_cust_tax_exempt_pkg ) {
 204     foreach my $cust_tax_exempt_pkg ( @{$self->_cust_tax_exempt_pkg} ) {
 205       $cust_tax_exempt_pkg->billpkgnum($self->billpkgnum);
 206       $error = $cust_tax_exempt_pkg->insert;
 207       if ( $error ) {
 208         $dbh->rollback if $oldAutoCommit;
 209         return "error inserting cust_tax_exempt_pkg: $error";
 210       }
 211     }
 212   }
 213
 214   my $tax_location = $self->get('cust_bill_pkg_tax_location');
 215   if ( $tax_location ) {
 216     foreach my $cust_bill_pkg_tax_location ( @$tax_location ) {
 217       $cust_bill_pkg_tax_location->billpkgnum($self->billpkgnum);
 218       $error = $cust_bill_pkg_tax_location->insert;
 219       if ( $error ) {
 220         $dbh->rollback if $oldAutoCommit;
 221         return "error inserting cust_bill_pkg_tax_location: $error";
 222       }
 223     }
 224   }
 225
 226   my $tax_rate_location = $self->get('cust_bill_pkg_tax_rate_location');
 227   if ( $tax_rate_location ) {
 228     foreach my $cust_bill_pkg_tax_rate_location ( @$tax_rate_location ) {
 229       $cust_bill_pkg_tax_rate_location->billpkgnum($self->billpkgnum);
 230       $error = $cust_bill_pkg_tax_rate_location->insert;
 231       if ( $error ) {
 232         $dbh->rollback if $oldAutoCommit;
 233         return "error inserting cust_bill_pkg_tax_rate_location: $error";
 234       }
 235     }
 236   }
 237
 238   my $cust_tax_adjustment = $self->get('cust_tax_adjustment');
 239   if ( $cust_tax_adjustment ) {
 240     $cust_tax_adjustment->billpkgnum($self->billpkgnum);
 241     $error = $cust_tax_adjustment->replace;
 242     if ( $error ) {
 243       $dbh->rollback if $oldAutoCommit;
 244       return "error replacing cust_tax_adjustment: $error";
 245     }
 246   }
 247
 248   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 249   '';
 250
 251 }
 252
 253 =item delete
 254
 255 Not recommended.
 256
 257 =cut
 258
 259 sub delete {
 260   my $self = shift;
 261
 262   local $SIG{HUP} = 'IGNORE';
 263   local $SIG{INT} = 'IGNORE';
 264   local $SIG{QUIT} = 'IGNORE';
 265   local $SIG{TERM} = 'IGNORE';
 266   local $SIG{TSTP} = 'IGNORE';
 267   local $SIG{PIPE} = 'IGNORE';
 268
 269   my $oldAutoCommit = $FS::UID::AutoCommit;
 270   local $FS::UID::AutoCommit = 0;
 271   my $dbh = dbh;
 272
 273   foreach my $table (qw(
 274     cust_bill_pkg_detail
 275     cust_bill_pkg_display
 276     cust_bill_pkg_tax_location
 277     cust_bill_pkg_tax_rate_location
 278     cust_tax_exempt_pkg
 279     cust_bill_pay_pkg
 280     cust_credit_bill_pkg
 281   )) {
 282
 283     foreach my $linked ( qsearch($table, { billpkgnum=>$self->billpkgnum }) ) {
 284       my $error = $linked->delete;
 285       if ( $error ) {
 286         $dbh->rollback if $oldAutoCommit;
 287         return $error;
 288       }
 289     }
 290
 291   }
 292
 293   foreach my $cust_tax_adjustment (
 294     qsearch('cust_tax_adjustment', { billpkgnum=>$self->billpkgnum })
 295   ) {
 296     $cust_tax_adjustment->billpkgnum(''); #NULL
 297     my $error = $cust_tax_adjustment->replace;
 298     if ( $error ) {
 299       $dbh->rollback if $oldAutoCommit;
 300       return $error;
 301     }
 302   }
 303
 304   my $error = $self->SUPER::delete(@_);
 305   if ( $error ) {
 306     $dbh->rollback if $oldAutoCommit;
 307     return $error;
 308   }
 309
 310   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 311
 312   '';
 313
 314 }
 315
 316 #alas, bin/follow-tax-rename
 317 #
 318 #=item replace OLD_RECORD
 319 #
 320 #Currently unimplemented.  This would be even more of an accounting nightmare
 321 #than deleteing the items.  Just don't do it.
 322 #
 323 #=cut
 324 #
 325 #sub replace {
 326 #  return "Can't modify cust_bill_pkg records!";
 327 #}
 328
 329 =item check
 330
 331 Checks all fields to make sure this is a valid line item.  If there is an
 332 error, returns the error, otherwise returns false.  Called by the insert
 333 method.
 334
 335 =cut
 336
 337 sub check {
 338   my $self = shift;
 339
 340   my $error =
 341          $self->ut_numbern('billpkgnum')
 342       || $self->ut_snumber('pkgnum')
 343       || $self->ut_number('invnum')
 344       || $self->ut_money('setup')
 345       || $self->ut_money('recur')
 346       || $self->ut_numbern('sdate')
 347       || $self->ut_numbern('edate')
 348       || $self->ut_textn('itemdesc')
 349       || $self->ut_textn('itemcomment')
 350       || $self->ut_enum('hidden', [ '', 'Y' ])
 351   ;
 352   return $error if $error;
 353
 354   #if ( $self->pkgnum != 0 ) { #allow unchecked pkgnum 0 for tax! (add to part_pkg?)
 355   if ( $self->pkgnum > 0 ) { #allow -1 for non-pkg line items and 0 for tax (add to part_pkg?)
 356     return "Unknown pkgnum ". $self->pkgnum
 357       unless qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 358   }
 359
 360   return "Unknown invnum"
 361     unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } );
 362
 363   $self->SUPER::check;
 364 }
 365
 366 =item cust_pkg
 367
 368 Returns the package (see L<FS::cust_pkg>) for this invoice line item.
 369
 370 =cut
 371
 372 sub cust_pkg {
 373   my $self = shift;
 374   carp "$me $self -> cust_pkg" if $DEBUG;
 375   qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 376 }
 377
 378 =item part_pkg
 379
 380 Returns the package definition for this invoice line item.
 381
 382 =cut
 383
 384 sub part_pkg {
 385   my $self = shift;
 386   if ( $self->pkgpart_override ) {
 387     qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart_override } );
 388   } else {
 389     my $part_pkg;
 390     my $cust_pkg = $self->cust_pkg;
 391     $part_pkg = $cust_pkg->part_pkg if $cust_pkg;
 392     $part_pkg;
 393   }
 394 }
 395
 396 =item cust_bill
 397
 398 Returns the invoice (see L<FS::cust_bill>) for this invoice line item.
 399
 400 =cut
 401
 402 sub cust_bill {
 403   my $self = shift;
 404   qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
 405 }
 406
 407 =item previous_cust_bill_pkg
 408
 409 Returns the previous cust_bill_pkg for this package, if any.
 410
 411 =cut
 412
 413 sub previous_cust_bill_pkg {
 414   my $self = shift;
 415   return unless $self->sdate;
 416   qsearchs({
 417     'table'    => 'cust_bill_pkg',
 418     'hashref'  => { 'pkgnum' => $self->pkgnum,
 419                     'sdate'  => { op=>'<', value=>$self->sdate },
 420                   },
 421     'order_by' => 'ORDER BY sdate DESC LIMIT 1',
 422   });
 423 }
 424
 425 =item details [ OPTION => VALUE ... ]
 426
 427 Returns an array of detail information for the invoice line item.
 428
 429 Currently available options are: I<format>, I<escape_function> and
 430 I<format_function>.
 431
 432 If I<format> is set to html or latex then the array members are improved
 433 for tabular appearance in those environments if possible.
 434
 435 If I<escape_function> is set then the array members are processed by this
 436 function before being returned.
 437
 438 I<format_function> overrides the normal HTML or LaTeX function for returning
 439 formatted CDRs.  It can be set to a subroutine which returns an empty list
 440 to skip usage detail:
 441
 442   'format_function' => sub { () },
 443
 444 =cut
 445
 446 sub details {
 447   my ( $self, %opt ) = @_;
 448   my $escape_function = $opt{escape_function} || sub { shift };
 449
 450   my $csv = new Text::CSV_XS;
 451
 452   if ( $opt{format_function} ) {
 453
 454     #this still expects to be passed a cust_bill_pkg_detail object as the
 455     #second argument, which is expensive
 456     carp "deprecated format_function passed to cust_bill_pkg->details";
 457     my $format_sub = $opt{format_function} if $opt{format_function};
 458
 459     map { ( $_->format eq 'C'
 460               ? &{$format_sub}( $_->detail, $_ )
 461               : &{$escape_function}( $_->detail )
 462           )
 463         }
 464       qsearch ({ 'table'    => 'cust_bill_pkg_detail',
 465                  'hashref'  => { 'billpkgnum' => $self->billpkgnum },
 466                  'order_by' => 'ORDER BY detailnum',
 467               });
 468
 469   } elsif ( $opt{'no_usage'} ) {
 470
 471     my $sql = "SELECT detail FROM cust_bill_pkg_detail ".
 472               "  WHERE billpkgnum = ". $self->billpkgnum.
 473               "    AND ( format IS NULL OR format != 'C' ) ".
 474               "  ORDER BY detailnum";
 475     my $sth = dbh->prepare($sql) or die dbh->errstr;
 476     $sth->execute or die $sth->errstr;
 477
 478     map &{$escape_function}( $_->[0] ), @{ $sth->fetchall_arrayref };
 479
 480   } else {
 481
 482     my $format_sub;
 483     my $format = $opt{format} || '';
 484     if ( $format eq 'html' ) {
 485
 486       $format_sub = sub { my $detail = shift;
 487                           $csv->parse($detail) or return "can't parse $detail";
 488                           join('</TD><TD>', map { &$escape_function($_) }
 489                                             $csv->fields
 490                               );
 491                         };
 492
 493     } elsif ( $format eq 'latex' ) {
 494
 495       $format_sub = sub {
 496         my $detail = shift;
 497         $csv->parse($detail) or return "can't parse $detail";
 498         #join(' & ', map { '\small{'. &$escape_function($_). '}' }
 499         #            $csv->fields );
 500         my $result = '';
 501         my $column = 1;
 502         foreach ($csv->fields) {
 503           $result .= ' & ' if $column > 1;
 504           if ($column > 6) {                     # KLUDGE ALERT!
 505             $result .= '\multicolumn{1}{l}{\scriptsize{'.
 506                        &$escape_function($_). '}}';
 507           }else{
 508             $result .= '\scriptsize{'.  &$escape_function($_). '}';
 509           }
 510           $column++;
 511         }
 512         $result;
 513       };
 514
 515     } else {
 516
 517       $format_sub = sub { my $detail = shift;
 518                           $csv->parse($detail) or return "can't parse $detail";
 519                           join(' - ', map { &$escape_function($_) }
 520                                       $csv->fields
 521                               );
 522                         };
 523
 524     }
 525
 526     my $sql = "SELECT format, detail FROM cust_bill_pkg_detail ".
 527               "  WHERE billpkgnum = ". $self->billpkgnum.
 528               "  ORDER BY detailnum";
 529     my $sth = dbh->prepare($sql) or die dbh->errstr;
 530     $sth->execute or die $sth->errstr;
 531
 532     #avoid the fetchall_arrayref and loop for less memory usage?
 533
 534     map { (defined($_->[0]) && $_->[0] eq 'C')
 535             ? &{$format_sub}(      $_->[1] )
 536             : &{$escape_function}( $_->[1] );
 537         }
 538       @{ $sth->fetchall_arrayref };
 539
 540   }
 541
 542 }
 543
 544 =item details_header [ OPTION => VALUE ... ]
 545
 546 Returns a list representing an invoice line item detail header, if any.
 547 This relies on the behavior of voip_cdr in that it expects the header
 548 to be the first CSV formatted detail (as is expected by invoice generation
 549 routines).  Returns the empty list otherwise.
 550
 551 =cut
 552
 553 sub details_header {
 554   my $self = shift;
 555   return '' unless defined dbdef->table('cust_bill_pkg_detail');
 556
 557   my $csv = new Text::CSV_XS;
 558
 559   my @detail =
 560     qsearch ({ 'table'    => 'cust_bill_pkg_detail',
 561                'hashref'  => { 'billpkgnum' => $self->billpkgnum,
 562                                'format'     => 'C',
 563                              },
 564                'order_by' => 'ORDER BY detailnum LIMIT 1',
 565             });
 566   return() unless scalar(@detail);
 567   $csv->parse($detail[0]->detail) or return ();
 568   $csv->fields;
 569 }
 570
 571 =item desc
 572
 573 Returns a description for this line item.  For typical line items, this is the
 574 I<pkg> field of the corresponding B<FS::part_pkg> object (see L<FS::part_pkg>).
 575 For one-shot line items and named taxes, it is the I<itemdesc> field of this
 576 line item, and for generic taxes, simply returns "Tax".
 577
 578 =cut
 579
 580 sub desc {
 581   my $self = shift;
 582
 583   if ( $self->pkgnum > 0 ) {
 584     $self->itemdesc || $self->part_pkg->pkg;
 585   } else {
 586     my $desc = $self->itemdesc || 'Tax';
 587     $desc .= ' '. $self->itemcomment if $self->itemcomment =~ /\S/;
 588     $desc;
 589   }
 590 }
 591
 592 =item owed_setup
 593
 594 Returns the amount owed (still outstanding) on this line item's setup fee,
 595 which is the amount of the line item minus all payment applications (see
 596 L<FS::cust_bill_pay_pkg> and credit applications (see
 597 L<FS::cust_credit_bill_pkg>).
 598
 599 =cut
 600
 601 sub owed_setup {
 602   my $self = shift;
 603   $self->owed('setup', @_);
 604 }
 605
 606 =item owed_recur
 607
 608 Returns the amount owed (still outstanding) on this line item's recurring fee,
 609 which is the amount of the line item minus all payment applications (see
 610 L<FS::cust_bill_pay_pkg> and credit applications (see
 611 L<FS::cust_credit_bill_pkg>).
 612
 613 =cut
 614
 615 sub owed_recur {
 616   my $self = shift;
 617   $self->owed('recur', @_);
 618 }
 619
 620 # modeled after cust_bill::owed...
 621 sub owed {
 622   my( $self, $field ) = @_;
 623   my $balance = $self->$field();
 624   $balance -= $_->amount foreach ( $self->cust_bill_pay_pkg($field) );
 625   $balance -= $_->amount foreach ( $self->cust_credit_bill_pkg($field) );
 626   $balance = sprintf( '%.2f', $balance );
 627   $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
 628   $balance;
 629 }
 630
 631 #modeled after owed
 632 sub payable {
 633   my( $self, $field ) = @_;
 634   my $balance = $self->$field();
 635   $balance -= $_->amount foreach ( $self->cust_credit_bill_pkg($field) );
 636   $balance = sprintf( '%.2f', $balance );
 637   $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
 638   $balance;
 639 }
 640
 641 sub cust_bill_pay_pkg {
 642   my( $self, $field ) = @_;
 643   qsearch( 'cust_bill_pay_pkg', { 'billpkgnum' => $self->billpkgnum,
 644                                   'setuprecur' => $field,
 645                                 }
 646          );
 647 }
 648
 649 sub cust_credit_bill_pkg {
 650   my( $self, $field ) = @_;
 651   qsearch( 'cust_credit_bill_pkg', { 'billpkgnum' => $self->billpkgnum,
 652                                      'setuprecur' => $field,
 653                                    }
 654          );
 655 }
 656
 657 =item units
 658
 659 Returns the number of billing units (for tax purposes) represented by this,
 660 line item.
 661
 662 =cut
 663
 664 sub units {
 665   my $self = shift;
 666   $self->pkgnum ? $self->part_pkg->calc_units($self->cust_pkg) : 0; # 1?
 667 }
 668
 669 =item quantity
 670
 671 =cut
 672
 673 sub quantity {
 674   my( $self, $value ) = @_;
 675   if ( defined($value) ) {
 676     $self->setfield('quantity', $value);
 677   }
 678   $self->getfield('quantity') || 1;
 679 }
 680
 681 =item unitsetup
 682
 683 =cut
 684
 685 sub unitsetup {
 686   my( $self, $value ) = @_;
 687   if ( defined($value) ) {
 688     $self->setfield('unitsetup', $value);
 689   }
 690   $self->getfield('unitsetup') eq ''
 691     ? $self->getfield('setup')
 692     : $self->getfield('unitsetup');
 693 }
 694
 695 =item unitrecur
 696
 697 =cut
 698
 699 sub unitrecur {
 700   my( $self, $value ) = @_;
 701   if ( defined($value) ) {
 702     $self->setfield('unitrecur', $value);
 703   }
 704   $self->getfield('unitrecur') eq ''
 705     ? $self->getfield('recur')
 706     : $self->getfield('unitrecur');
 707 }
 708
 709 =item set_display OPTION => VALUE ...
 710
 711 A helper method for I<insert>, populates the pseudo-field B<display> with
 712 appropriate FS::cust_bill_pkg_display objects.
 713
 714 Options are passed as a list of name/value pairs.  Options are:
 715
 716 part_pkg: FS::part_pkg object from this line item's package.
 717
 718 real_pkgpart: if this line item comes from a bundled package, the pkgpart
 719 of the owning package.  Otherwise the same as the part_pkg's pkgpart above.
 720
 721 =cut
 722
 723 sub set_display {
 724   my( $self, %opt ) = @_;
 725   my $part_pkg = $opt{'part_pkg'};
 726   my $cust_pkg = new FS::cust_pkg { pkgpart => $opt{real_pkgpart} };
 727
 728   my $conf = new FS::Conf;
 729
 730   # whether to break this down into setup/recur/usage
 731   my $separate = $conf->exists('separate_usage');
 732
 733   my $usage_mandate =            $part_pkg->option('usage_mandate', 'Hush!')
 734                     || $cust_pkg->part_pkg->option('usage_mandate', 'Hush!');
 735
 736   # or use the category from $opt{'part_pkg'} if its not bundled?
 737   my $categoryname = $cust_pkg->part_pkg->categoryname;
 738
 739   # if we don't have to separate setup/recur/usage, or put this in a
 740   # package-specific section, or display a usage summary, then don't
 741   # even create one of these.  The item will just display in the unnamed
 742   # section as a single line plus details.
 743   return $self->set('display', [])
 744     unless $separate || $categoryname || $usage_mandate;
 745
 746   my @display = ();
 747
 748   my %hash = ( 'section' => $categoryname );
 749
 750   # whether to put usage details in a separate section, and if so, which one
 751   my $usage_section =            $part_pkg->option('usage_section', 'Hush!')
 752                     || $cust_pkg->part_pkg->option('usage_section', 'Hush!');
 753
 754   # whether to show a usage summary line (total usage charges, no details)
 755   my $summary =            $part_pkg->option('summarize_usage', 'Hush!')
 756               || $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
 757
 758   if ( $separate ) {
 759     # create lines for setup and (non-usage) recur, in the main section
 760     push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
 761     push @display, new FS::cust_bill_pkg_display { type => 'R', %hash };
 762   } else {
 763     # display everything in a single line
 764     push @display, new FS::cust_bill_pkg_display
 765                      { type => '',
 766                        %hash,
 767                        # and if usage_mandate is enabled, hide details
 768                        # (this only works on multisection invoices...)
 769                        ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
 770                      };
 771   }
 772
 773   if ($separate && $usage_section && $summary) {
 774     # create a line for the usage summary in the main section
 775     push @display, new FS::cust_bill_pkg_display { type    => 'U',
 776                                                    summary => 'Y',
 777                                                    %hash,
 778                                                  };
 779   }
 780
 781   if ($usage_mandate || ($usage_section && $summary) ) {
 782     $hash{post_total} = 'Y';
 783   }
 784
 785   if ($separate || $usage_mandate) {
 786     # show call details for this line item in the usage section.
 787     # if usage_mandate is on, this will display below the section subtotal.
 788     # this also happens if usage is in a separate section and there's a
 789     # summary in the main section, though I'm not sure why.
 790     $hash{section} = $usage_section if $usage_section;
 791     push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
 792   }
 793
 794   $self->set('display', \@display);
 795
 796 }
 797
 798 =item disintegrate
 799
 800 Returns a list of cust_bill_pkg objects each with no more than a single class
 801 (including setup or recur) of charge.
 802
 803 =cut
 804
 805 sub disintegrate {
 806   my $self = shift;
 807   # XXX this goes away with cust_bill_pkg refactor
 808
 809   my $cust_bill_pkg = new FS::cust_bill_pkg { $self->hash };
 810   my %cust_bill_pkg = ();
 811
 812   $cust_bill_pkg{setup} = $cust_bill_pkg if $cust_bill_pkg->setup;
 813   $cust_bill_pkg{recur} = $cust_bill_pkg if $cust_bill_pkg->recur;
 814
 815
 816   #split setup and recur
 817   if ($cust_bill_pkg->setup && $cust_bill_pkg->recur) {
 818     my $cust_bill_pkg_recur = new FS::cust_bill_pkg { $cust_bill_pkg->hash };
 819     $cust_bill_pkg->set('details', []);
 820     $cust_bill_pkg->recur(0);
 821     $cust_bill_pkg->unitrecur(0);
 822     $cust_bill_pkg->type('');
 823     $cust_bill_pkg_recur->setup(0);
 824     $cust_bill_pkg_recur->unitsetup(0);
 825     $cust_bill_pkg{recur} = $cust_bill_pkg_recur;
 826
 827   }
 828
 829   #split usage from recur
 830   my $usage = sprintf( "%.2f", $cust_bill_pkg{recur}->usage )
 831     if exists($cust_bill_pkg{recur});
 832   warn "usage is $usage\n" if $DEBUG > 1;
 833   if ($usage) {
 834     my $cust_bill_pkg_usage =
 835         new FS::cust_bill_pkg { $cust_bill_pkg{recur}->hash };
 836     $cust_bill_pkg_usage->recur( $usage );
 837     $cust_bill_pkg_usage->type( 'U' );
 838     my $recur = sprintf( "%.2f", $cust_bill_pkg{recur}->recur - $usage );
 839     $cust_bill_pkg{recur}->recur( $recur );
 840     $cust_bill_pkg{recur}->type( '' );
 841     $cust_bill_pkg{recur}->set('details', []);
 842     $cust_bill_pkg{''} = $cust_bill_pkg_usage;
 843   }
 844
 845   #subdivide usage by usage_class
 846   if (exists($cust_bill_pkg{''})) {
 847     foreach my $class (grep { $_ } $self->usage_classes) {
 848       my $usage = sprintf( "%.2f", $cust_bill_pkg{''}->usage($class) );
 849       my $cust_bill_pkg_usage =
 850           new FS::cust_bill_pkg { $cust_bill_pkg{''}->hash };
 851       $cust_bill_pkg_usage->recur( $usage );
 852       $cust_bill_pkg_usage->set('details', []);
 853       my $classless = sprintf( "%.2f", $cust_bill_pkg{''}->recur - $usage );
 854       $cust_bill_pkg{''}->recur( $classless );
 855       $cust_bill_pkg{$class} = $cust_bill_pkg_usage;
 856     }
 857     warn "Unexpected classless usage value: ". $cust_bill_pkg{''}->recur
 858       if ($cust_bill_pkg{''}->recur && $cust_bill_pkg{''}->recur < 0);
 859     delete $cust_bill_pkg{''}
 860       unless ($cust_bill_pkg{''}->recur && $cust_bill_pkg{''}->recur > 0);
 861   }
 862
 863 #  # sort setup,recur,'', and the rest numeric && return
 864 #  my @result = map { $cust_bill_pkg{$_} }
 865 #               sort { my $ad = ($a=~/^\d+$/); my $bd = ($b=~/^\d+$/);
 866 #                      ( $ad cmp $bd ) || ( $ad ? $a<=>$b : $b cmp $a )
 867 #                    }
 868 #               keys %cust_bill_pkg;
 869 #
 870 #  return (@result);
 871
 872    %cust_bill_pkg;
 873 }
 874
 875 =item usage CLASSNUM
 876
 877 Returns the amount of the charge associated with usage class CLASSNUM if
 878 CLASSNUM is defined.  Otherwise returns the total charge associated with
 879 usage.
 880
 881 =cut
 882
 883 sub usage {
 884   my( $self, $classnum ) = @_;
 885
 886   if ( $self->get('details') ) {
 887
 888     my $sum = 0;
 889     foreach my $value (
 890       map { ref($_) eq 'HASH'
 891               ? $_->{'amount'}
 892               : $_->[2]
 893           }
 894       grep { ref($_) && ( defined($classnum)
 895                             ? $classnum eq ( ref($_) eq 'HASH'
 896                                                ? $_->{'classnum'}
 897                                                : $_->[3]
 898                                            )
 899                             : 1
 900                         )
 901            }
 902       @{ $self->get('details') }
 903     ) {
 904       $sum += $value if $value;
 905     }
 906
 907     return $sum;
 908
 909   } else {
 910
 911     my $sql = 'SELECT SUM(COALESCE(amount,0)) FROM cust_bill_pkg_detail '.
 912               ' WHERE billpkgnum = '. $self->billpkgnum;
 913     $sql .= " AND classnum = $classnum" if defined($classnum);
 914
 915     my $sth = dbh->prepare($sql) or die dbh->errstr;
 916     $sth->execute or die $sth->errstr;
 917
 918     return $sth->fetchrow_arrayref->[0] || 0;
 919
 920   }
 921
 922 }
 923
 924 =item usage_classes
 925
 926 Returns a list of usage classnums associated with this invoice line's
 927 details.
 928
 929 =cut
 930
 931 sub usage_classes {
 932   my( $self ) = @_;
 933
 934   if ( $self->get('details') ) {
 935
 936     my %seen = ();
 937     foreach my $detail ( grep { ref($_) } @{$self->get('details')} ) {
 938       $seen{ (ref($detail) eq 'HASH'
 939                ? $detail->{'classnum'}
 940                : $detail->[3]) || ''
 941            } = 1;
 942     }
 943     keys %seen;
 944
 945   } else {
 946
 947     map { $_->classnum }
 948         qsearch({ table   => 'cust_bill_pkg_detail',
 949                   hashref => { billpkgnum => $self->billpkgnum },
 950                   select  => 'DISTINCT classnum',
 951                });
 952
 953   }
 954
 955 }
 956
 957 =item cust_bill_pkg_display [ type => TYPE ]
 958
 959 Returns an array of display information for the invoice line item optionally
 960 limited to 'TYPE'.
 961
 962 =cut
 963
 964 sub cust_bill_pkg_display {
 965   my ( $self, %opt ) = @_;
 966
 967   my $default =
 968     new FS::cust_bill_pkg_display { billpkgnum =>$self->billpkgnum };
 969
 970   return ( $default ) unless defined dbdef->table('cust_bill_pkg_display');#hmmm
 971
 972   my $type = $opt{type} if exists $opt{type};
 973   my @result;
 974
 975   if ( $self->get('display') ) {
 976     @result = grep { defined($type) ? ($type eq $_->type) : 1 }
 977               @{ $self->get('display') };
 978   } else {
 979     my $hashref = { 'billpkgnum' => $self->billpkgnum };
 980     $hashref->{type} = $type if defined($type);
 981
 982     @result = qsearch ({ 'table'    => 'cust_bill_pkg_display',
 983                          'hashref'  => { 'billpkgnum' => $self->billpkgnum },
 984                          'order_by' => 'ORDER BY billpkgdisplaynum',
 985                       });
 986   }
 987
 988   push @result, $default unless ( scalar(@result) || $type );
 989
 990   @result;
 991
 992 }
 993
 994 # reserving this name for my friends FS::{tax_rate|cust_main_county}::taxline
 995 # and FS::cust_main::bill
 996
 997 sub _cust_tax_exempt_pkg {
 998   my ( $self ) = @_;
 999
1000   $self->{Hash}->{_cust_tax_exempt_pkg} or
1001   $self->{Hash}->{_cust_tax_exempt_pkg} = [];
1002
1003 }
1004
1005 =item cust_bill_pkg_tax_Xlocation
1006
1007 Returns the list of associated cust_bill_pkg_tax_location and/or
1008 cust_bill_pkg_tax_rate_location objects
1009
1010 =cut
1011
1012 sub cust_bill_pkg_tax_Xlocation {
1013   my $self = shift;
1014
1015   my %hash = ( 'billpkgnum' => $self->billpkgnum );
1016
1017   (
1018     qsearch ( 'cust_bill_pkg_tax_location', { %hash  } ),
1019     qsearch ( 'cust_bill_pkg_tax_rate_location', { %hash } )
1020   );
1021
1022 }
1023
1024 =item cust_bill_pkg_detail [ CLASSNUM ]
1025
1026 Returns the list of associated cust_bill_pkg_detail objects
1027 The optional CLASSNUM argument will limit the details to the specified usage
1028 class.
1029
1030 =cut
1031
1032 sub cust_bill_pkg_detail {
1033   my $self = shift;
1034   my $classnum = shift || '';
1035
1036   my %hash = ( 'billpkgnum' => $self->billpkgnum );
1037   $hash{classnum} = $classnum if $classnum;
1038
1039   qsearch( 'cust_bill_pkg_detail', \%hash ),
1040
1041 }
1042
1043 =item cust_bill_pkg_discount
1044
1045 Returns the list of associated cust_bill_pkg_discount objects.
1046
1047 =cut
1048
1049 sub cust_bill_pkg_discount {
1050   my $self = shift;
1051   qsearch( 'cust_bill_pkg_discount', { 'billpkgnum' => $self->billpkgnum } );
1052 }
1053
1054 =item recur_show_zero
1055
1056 =cut
1057
1058 sub recur_show_zero {
1059   #my $self = shift;
1060   #   $self->recur == 0
1061   #&& $self->pkgnum
1062   #&& $self->cust_pkg->part_pkg->recur_show_zero;
1063
1064   shift->_X_show_zero('recur');
1065
1066 }
1067
1068 sub setup_show_zero {
1069   shift->_X_show_zero('setup');
1070 }
1071
1072 sub _X_show_zero {
1073   my( $self, $what ) = @_;
1074
1075   return 0 unless $self->$what() == 0 && $self->pkgnum;
1076
1077   $self->cust_pkg->_X_show_zero($what);
1078 }
1079
1080 =back
1081
1082 =head1 CLASS METHODS
1083
1084 =over 4
1085
1086 =item usage_sql
1087
1088 Returns an SQL expression for the total usage charges in details on
1089 an item.
1090
1091 =cut
1092
1093 my $usage_sql =
1094   '(SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
1095     FROM cust_bill_pkg_detail
1096     WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum)';
1097
1098 sub usage_sql { $usage_sql }
1099
1100 # this makes owed_sql, etc. much more concise
1101 sub charged_sql {
1102   my ($class, $start, $end, %opt) = @_;
1103   my $charged =
1104     $opt{setuprecur} =~ /^s/ ? 'cust_bill_pkg.setup' :
1105     $opt{setuprecur} =~ /^r/ ? 'cust_bill_pkg.recur' :
1106     'cust_bill_pkg.setup + cust_bill_pkg.recur';
1107
1108   if ($opt{no_usage} and $charged =~ /recur/) {
1109     $charged = "$charged - $usage_sql"
1110   }
1111
1112   $charged;
1113 }
1114
1115
1116 =item owed_sql [ BEFORE, AFTER, OPTIONS ]
1117
1118 Returns an SQL expression for the amount owed.  BEFORE and AFTER specify
1119 a date window.  OPTIONS may include 'no_usage' (excludes usage charges)
1120 and 'setuprecur' (set to "setup" or "recur" to limit to one or the other).
1121
1122 =cut
1123
1124 sub owed_sql {
1125   my $class = shift;
1126   '(' . $class->charged_sql(@_) .
1127   ' - ' . $class->paid_sql(@_) .
1128   ' - ' . $class->credited_sql(@_) . ')'
1129 }
1130
1131 =item paid_sql [ BEFORE, AFTER, OPTIONS ]
1132
1133 Returns an SQL expression for the sum of payments applied to this item.
1134
1135 =cut
1136
1137 sub paid_sql {
1138   my ($class, $start, $end, %opt) = @_;
1139   my $s = $start ? "AND cust_bill_pay._date <= $start" : '';
1140   my $e = $end   ? "AND cust_bill_pay._date >  $end"   : '';
1141   my $setuprecur =
1142     $opt{setuprecur} =~ /^s/ ? 'setup' :
1143     $opt{setuprecur} =~ /^r/ ? 'recur' :
1144     '';
1145   $setuprecur &&= "AND setuprecur = '$setuprecur'";
1146
1147   my $paid = "( SELECT COALESCE(SUM(cust_bill_pay_pkg.amount),0)
1148      FROM cust_bill_pay_pkg JOIN cust_bill_pay USING (billpaynum)
1149      WHERE cust_bill_pay_pkg.billpkgnum = cust_bill_pkg.billpkgnum
1150            $s $e $setuprecur )";
1151
1152   if ( $opt{no_usage} ) {
1153     # cap the amount paid at the sum of non-usage charges,
1154     # minus the amount credited against non-usage charges
1155     "LEAST($paid, ".
1156       $class->charged_sql($start, $end, %opt) . ' - ' .
1157       $class->credited_sql($start, $end, %opt).')';
1158   }
1159   else {
1160     $paid;
1161   }
1162
1163 }
1164
1165 sub credited_sql {
1166   my ($class, $start, $end, %opt) = @_;
1167   my $s = $start ? "AND cust_credit_bill._date <= $start" : '';
1168   my $e = $end   ? "AND cust_credit_bill._date >  $end"   : '';
1169   my $setuprecur =
1170     $opt{setuprecur} =~ /^s/ ? 'setup' :
1171     $opt{setuprecur} =~ /^r/ ? 'recur' :
1172     '';
1173   $setuprecur &&= "AND setuprecur = '$setuprecur'";
1174
1175   my $credited = "( SELECT COALESCE(SUM(cust_credit_bill_pkg.amount),0)
1176      FROM cust_credit_bill_pkg JOIN cust_credit_bill USING (creditbillnum)
1177      WHERE cust_credit_bill_pkg.billpkgnum = cust_bill_pkg.billpkgnum
1178            $s $e $setuprecur )";
1179
1180   if ( $opt{no_usage} ) {
1181     # cap the amount credited at the sum of non-usage charges
1182     "LEAST($credited, ". $class->charged_sql($start, $end, %opt).')';
1183   }
1184   else {
1185     $credited;
1186   }
1187
1188 }
1189
1190 =back
1191
1192 =head1 BUGS
1193
1194 setup and recur shouldn't be separate fields.  There should be one "amount"
1195 field and a flag to tell you if it is a setup/one-time fee or a recurring fee.
1196
1197 A line item with both should really be two separate records (preserving
1198 sdate and edate for setup fees for recurring packages - that information may
1199 be valuable later).  Invoice generation (cust_main::bill), invoice printing
1200 (cust_bill), tax reports (report_tax.cgi) and line item reports
1201 (cust_bill_pkg.cgi) would need to be updated.
1202
1203 owed_setup and owed_recur could then be repaced by just owed, and
1204 cust_bill::open_cust_bill_pkg and
1205 cust_bill_ApplicationCommon::apply_to_lineitems could be simplified.
1206
1207 =head1 SEE ALSO
1208
1209 L<FS::Record>, L<FS::cust_bill>, L<FS::cust_pkg>, L<FS::cust_main>, schema.html
1210 from the base documentation.
1211
1212 =cut
1213
1214 1;
1215