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 hash: keys are "setup", "recur" or usage classnum, values are
 801 FS::cust_bill_pkg objects, each with no more than a single class (setup or
 802 recur) of charge.
 803
 804 =cut
 805
 806 sub disintegrate {
 807   my $self = shift;
 808   # XXX this goes away with cust_bill_pkg refactor
 809
 810   my $cust_bill_pkg = new FS::cust_bill_pkg { $self->hash };
 811   my %cust_bill_pkg = ();
 812
 813   $cust_bill_pkg{setup} = $cust_bill_pkg if $cust_bill_pkg->setup;
 814   $cust_bill_pkg{recur} = $cust_bill_pkg if $cust_bill_pkg->recur;
 815
 816
 817   #split setup and recur
 818   if ($cust_bill_pkg->setup && $cust_bill_pkg->recur) {
 819     my $cust_bill_pkg_recur = new FS::cust_bill_pkg { $cust_bill_pkg->hash };
 820     $cust_bill_pkg->set('details', []);
 821     $cust_bill_pkg->recur(0);
 822     $cust_bill_pkg->unitrecur(0);
 823     $cust_bill_pkg->type('');
 824     $cust_bill_pkg_recur->setup(0);
 825     $cust_bill_pkg_recur->unitsetup(0);
 826     $cust_bill_pkg{recur} = $cust_bill_pkg_recur;
 827
 828   }
 829
 830   #split usage from recur
 831   my $usage = sprintf( "%.2f", $cust_bill_pkg{recur}->usage )
 832     if exists($cust_bill_pkg{recur});
 833   warn "usage is $usage\n" if $DEBUG > 1;
 834   if ($usage) {
 835     my $cust_bill_pkg_usage =
 836         new FS::cust_bill_pkg { $cust_bill_pkg{recur}->hash };
 837     $cust_bill_pkg_usage->recur( $usage );
 838     $cust_bill_pkg_usage->type( 'U' );
 839     my $recur = sprintf( "%.2f", $cust_bill_pkg{recur}->recur - $usage );
 840     $cust_bill_pkg{recur}->recur( $recur );
 841     $cust_bill_pkg{recur}->type( '' );
 842     $cust_bill_pkg{recur}->set('details', []);
 843     $cust_bill_pkg{''} = $cust_bill_pkg_usage;
 844   }
 845
 846   #subdivide usage by usage_class
 847   if (exists($cust_bill_pkg{''})) {
 848     foreach my $class (grep { $_ } $self->usage_classes) {
 849       my $usage = sprintf( "%.2f", $cust_bill_pkg{''}->usage($class) );
 850       my $cust_bill_pkg_usage =
 851           new FS::cust_bill_pkg { $cust_bill_pkg{''}->hash };
 852       $cust_bill_pkg_usage->recur( $usage );
 853       $cust_bill_pkg_usage->set('details', []);
 854       my $classless = sprintf( "%.2f", $cust_bill_pkg{''}->recur - $usage );
 855       $cust_bill_pkg{''}->recur( $classless );
 856       $cust_bill_pkg{$class} = $cust_bill_pkg_usage;
 857     }
 858     warn "Unexpected classless usage value: ". $cust_bill_pkg{''}->recur
 859       if ($cust_bill_pkg{''}->recur && $cust_bill_pkg{''}->recur < 0);
 860     delete $cust_bill_pkg{''}
 861       unless ($cust_bill_pkg{''}->recur && $cust_bill_pkg{''}->recur > 0);
 862   }
 863
 864 #  # sort setup,recur,'', and the rest numeric && return
 865 #  my @result = map { $cust_bill_pkg{$_} }
 866 #               sort { my $ad = ($a=~/^\d+$/); my $bd = ($b=~/^\d+$/);
 867 #                      ( $ad cmp $bd ) || ( $ad ? $a<=>$b : $b cmp $a )
 868 #                    }
 869 #               keys %cust_bill_pkg;
 870 #
 871 #  return (@result);
 872
 873    %cust_bill_pkg;
 874 }
 875
 876 =item usage CLASSNUM
 877
 878 Returns the amount of the charge associated with usage class CLASSNUM if
 879 CLASSNUM is defined.  Otherwise returns the total charge associated with
 880 usage.
 881
 882 =cut
 883
 884 sub usage {
 885   my( $self, $classnum ) = @_;
 886
 887   if ( $self->get('details') ) {
 888
 889     my $sum = 0;
 890     foreach my $value (
 891       map { ref($_) eq 'HASH'
 892               ? $_->{'amount'}
 893               : $_->[2]
 894           }
 895       grep { ref($_) && ( defined($classnum)
 896                             ? $classnum eq ( ref($_) eq 'HASH'
 897                                                ? $_->{'classnum'}
 898                                                : $_->[3]
 899                                            )
 900                             : 1
 901                         )
 902            }
 903       @{ $self->get('details') }
 904     ) {
 905       $sum += $value if $value;
 906     }
 907
 908     return $sum;
 909
 910   } else {
 911
 912     my $sql = 'SELECT SUM(COALESCE(amount,0)) FROM cust_bill_pkg_detail '.
 913               ' WHERE billpkgnum = '. $self->billpkgnum;
 914     $sql .= " AND classnum = $classnum" if defined($classnum);
 915
 916     my $sth = dbh->prepare($sql) or die dbh->errstr;
 917     $sth->execute or die $sth->errstr;
 918
 919     return $sth->fetchrow_arrayref->[0] || 0;
 920
 921   }
 922
 923 }
 924
 925 =item usage_classes
 926
 927 Returns a list of usage classnums associated with this invoice line's
 928 details.
 929
 930 =cut
 931
 932 sub usage_classes {
 933   my( $self ) = @_;
 934
 935   if ( $self->get('details') ) {
 936
 937     my %seen = ();
 938     foreach my $detail ( grep { ref($_) } @{$self->get('details')} ) {
 939       $seen{ (ref($detail) eq 'HASH'
 940                ? $detail->{'classnum'}
 941                : $detail->[3]) || ''
 942            } = 1;
 943     }
 944     keys %seen;
 945
 946   } else {
 947
 948     map { $_->classnum }
 949         qsearch({ table   => 'cust_bill_pkg_detail',
 950                   hashref => { billpkgnum => $self->billpkgnum },
 951                   select  => 'DISTINCT classnum',
 952                });
 953
 954   }
 955
 956 }
 957
 958 =item cust_bill_pkg_display [ type => TYPE ]
 959
 960 Returns an array of display information for the invoice line item optionally
 961 limited to 'TYPE'.
 962
 963 =cut
 964
 965 sub cust_bill_pkg_display {
 966   my ( $self, %opt ) = @_;
 967
 968   my $default =
 969     new FS::cust_bill_pkg_display { billpkgnum =>$self->billpkgnum };
 970
 971   return ( $default ) unless defined dbdef->table('cust_bill_pkg_display');#hmmm
 972
 973   my $type = $opt{type} if exists $opt{type};
 974   my @result;
 975
 976   if ( $self->get('display') ) {
 977     @result = grep { defined($type) ? ($type eq $_->type) : 1 }
 978               @{ $self->get('display') };
 979   } else {
 980     my $hashref = { 'billpkgnum' => $self->billpkgnum };
 981     $hashref->{type} = $type if defined($type);
 982
 983     @result = qsearch ({ 'table'    => 'cust_bill_pkg_display',
 984                          'hashref'  => { 'billpkgnum' => $self->billpkgnum },
 985                          'order_by' => 'ORDER BY billpkgdisplaynum',
 986                       });
 987   }
 988
 989   push @result, $default unless ( scalar(@result) || $type );
 990
 991   @result;
 992
 993 }
 994
 995 # reserving this name for my friends FS::{tax_rate|cust_main_county}::taxline
 996 # and FS::cust_main::bill
 997
 998 sub _cust_tax_exempt_pkg {
 999   my ( $self ) = @_;
1000
1001   $self->{Hash}->{_cust_tax_exempt_pkg} or
1002   $self->{Hash}->{_cust_tax_exempt_pkg} = [];
1003
1004 }
1005
1006 =item cust_bill_pkg_tax_Xlocation
1007
1008 Returns the list of associated cust_bill_pkg_tax_location and/or
1009 cust_bill_pkg_tax_rate_location objects
1010
1011 =cut
1012
1013 sub cust_bill_pkg_tax_Xlocation {
1014   my $self = shift;
1015
1016   my %hash = ( 'billpkgnum' => $self->billpkgnum );
1017
1018   (
1019     qsearch ( 'cust_bill_pkg_tax_location', { %hash  } ),
1020     qsearch ( 'cust_bill_pkg_tax_rate_location', { %hash } )
1021   );
1022
1023 }
1024
1025 =item cust_bill_pkg_detail [ CLASSNUM ]
1026
1027 Returns the list of associated cust_bill_pkg_detail objects
1028 The optional CLASSNUM argument will limit the details to the specified usage
1029 class.
1030
1031 =cut
1032
1033 sub cust_bill_pkg_detail {
1034   my $self = shift;
1035   my $classnum = shift || '';
1036
1037   my %hash = ( 'billpkgnum' => $self->billpkgnum );
1038   $hash{classnum} = $classnum if $classnum;
1039
1040   qsearch( 'cust_bill_pkg_detail', \%hash ),
1041
1042 }
1043
1044 =item cust_bill_pkg_discount
1045
1046 Returns the list of associated cust_bill_pkg_discount objects.
1047
1048 =cut
1049
1050 sub cust_bill_pkg_discount {
1051   my $self = shift;
1052   qsearch( 'cust_bill_pkg_discount', { 'billpkgnum' => $self->billpkgnum } );
1053 }
1054
1055 =item recur_show_zero
1056
1057 =cut
1058
1059 sub recur_show_zero {
1060   #my $self = shift;
1061   #   $self->recur == 0
1062   #&& $self->pkgnum
1063   #&& $self->cust_pkg->part_pkg->recur_show_zero;
1064
1065   shift->_X_show_zero('recur');
1066
1067 }
1068
1069 sub setup_show_zero {
1070   shift->_X_show_zero('setup');
1071 }
1072
1073 sub _X_show_zero {
1074   my( $self, $what ) = @_;
1075
1076   return 0 unless $self->$what() == 0 && $self->pkgnum;
1077
1078   $self->cust_pkg->_X_show_zero($what);
1079 }
1080
1081 =item credited [ BEFORE, AFTER, OPTIONS ]
1082
1083 Returns the sum of credits applied to this item.  Arguments are the same as
1084 owed_sql/paid_sql/credited_sql.
1085
1086 =cut
1087
1088 sub credited {
1089   my $self = shift;
1090   $self->scalar_sql('SELECT '. $self->credited_sql(@_).' FROM cust_bill_pkg WHERE billpkgnum = ?', $self->billpkgnum);
1091 }
1092
1093 =back
1094
1095 =head1 CLASS METHODS
1096
1097 =over 4
1098
1099 =item usage_sql
1100
1101 Returns an SQL expression for the total usage charges in details on
1102 an item.
1103
1104 =cut
1105
1106 my $usage_sql =
1107   '(SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0)
1108     FROM cust_bill_pkg_detail
1109     WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum)';
1110
1111 sub usage_sql { $usage_sql }
1112
1113 # this makes owed_sql, etc. much more concise
1114 sub charged_sql {
1115   my ($class, $start, $end, %opt) = @_;
1116   my $charged =
1117     $opt{setuprecur} =~ /^s/ ? 'cust_bill_pkg.setup' :
1118     $opt{setuprecur} =~ /^r/ ? 'cust_bill_pkg.recur' :
1119     'cust_bill_pkg.setup + cust_bill_pkg.recur';
1120
1121   if ($opt{no_usage} and $charged =~ /recur/) {
1122     $charged = "$charged - $usage_sql"
1123   }
1124
1125   $charged;
1126 }
1127
1128
1129 =item owed_sql [ BEFORE, AFTER, OPTIONS ]
1130
1131 Returns an SQL expression for the amount owed.  BEFORE and AFTER specify
1132 a date window.  OPTIONS may include 'no_usage' (excludes usage charges)
1133 and 'setuprecur' (set to "setup" or "recur" to limit to one or the other).
1134
1135 =cut
1136
1137 sub owed_sql {
1138   my $class = shift;
1139   '(' . $class->charged_sql(@_) .
1140   ' - ' . $class->paid_sql(@_) .
1141   ' - ' . $class->credited_sql(@_) . ')'
1142 }
1143
1144 =item paid_sql [ BEFORE, AFTER, OPTIONS ]
1145
1146 Returns an SQL expression for the sum of payments applied to this item.
1147
1148 =cut
1149
1150 sub paid_sql {
1151   my ($class, $start, $end, %opt) = @_;
1152   my $s = $start ? "AND cust_bill_pay._date <= $start" : '';
1153   my $e = $end   ? "AND cust_bill_pay._date >  $end"   : '';
1154   my $setuprecur =
1155     $opt{setuprecur} =~ /^s/ ? 'setup' :
1156     $opt{setuprecur} =~ /^r/ ? 'recur' :
1157     '';
1158   $setuprecur &&= "AND setuprecur = '$setuprecur'";
1159
1160   my $paid = "( SELECT COALESCE(SUM(cust_bill_pay_pkg.amount),0)
1161      FROM cust_bill_pay_pkg JOIN cust_bill_pay USING (billpaynum)
1162      WHERE cust_bill_pay_pkg.billpkgnum = cust_bill_pkg.billpkgnum
1163            $s $e $setuprecur )";
1164
1165   if ( $opt{no_usage} ) {
1166     # cap the amount paid at the sum of non-usage charges,
1167     # minus the amount credited against non-usage charges
1168     "LEAST($paid, ".
1169       $class->charged_sql($start, $end, %opt) . ' - ' .
1170       $class->credited_sql($start, $end, %opt).')';
1171   }
1172   else {
1173     $paid;
1174   }
1175
1176 }
1177
1178 sub credited_sql {
1179   my ($class, $start, $end, %opt) = @_;
1180   my $s = $start ? "AND cust_credit_bill._date <= $start" : '';
1181   my $e = $end   ? "AND cust_credit_bill._date >  $end"   : '';
1182   my $setuprecur =
1183     $opt{setuprecur} =~ /^s/ ? 'setup' :
1184     $opt{setuprecur} =~ /^r/ ? 'recur' :
1185     '';
1186   $setuprecur &&= "AND setuprecur = '$setuprecur'";
1187
1188   my $credited = "( SELECT COALESCE(SUM(cust_credit_bill_pkg.amount),0)
1189      FROM cust_credit_bill_pkg JOIN cust_credit_bill USING (creditbillnum)
1190      WHERE cust_credit_bill_pkg.billpkgnum = cust_bill_pkg.billpkgnum
1191            $s $e $setuprecur )";
1192
1193   if ( $opt{no_usage} ) {
1194     # cap the amount credited at the sum of non-usage charges
1195     "LEAST($credited, ". $class->charged_sql($start, $end, %opt).')';
1196   }
1197   else {
1198     $credited;
1199   }
1200
1201 }
1202
1203 =back
1204
1205 =head1 BUGS
1206
1207 setup and recur shouldn't be separate fields.  There should be one "amount"
1208 field and a flag to tell you if it is a setup/one-time fee or a recurring fee.
1209
1210 A line item with both should really be two separate records (preserving
1211 sdate and edate for setup fees for recurring packages - that information may
1212 be valuable later).  Invoice generation (cust_main::bill), invoice printing
1213 (cust_bill), tax reports (report_tax.cgi) and line item reports
1214 (cust_bill_pkg.cgi) would need to be updated.
1215
1216 owed_setup and owed_recur could then be repaced by just owed, and
1217 cust_bill::open_cust_bill_pkg and
1218 cust_bill_ApplicationCommon::apply_to_lineitems could be simplified.
1219
1220 =head1 SEE ALSO
1221
1222 L<FS::Record>, L<FS::cust_bill>, L<FS::cust_pkg>, L<FS::cust_main>, schema.html
1223 from the base documentation.
1224
1225 =cut
1226
1227 1;
1228