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