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