FS/FS/cust_bill_pkg.pm

   1 package FS::cust_bill_pkg;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG );
   5 use FS::Record qw( qsearch qsearchs dbdef dbh );
   6 use FS::cust_main_Mixin;
   7 use FS::cust_pkg;
   8 use FS::part_pkg;
   9 use FS::cust_bill;
  10 use FS::cust_bill_pkg_detail;
  11 use FS::cust_bill_pkg_display;
  12 use FS::cust_bill_pay_pkg;
  13 use FS::cust_credit_bill_pkg;
  14 use FS::cust_tax_exempt_pkg;
  15
  16 @ISA = qw( FS::cust_main_Mixin FS::Record );
  17
  18 $DEBUG = 0;
  19
  20 =head1 NAME
  21
  22 FS::cust_bill_pkg - Object methods for cust_bill_pkg records
  23
  24 =head1 SYNOPSIS
  25
  26   use FS::cust_bill_pkg;
  27
  28   $record = new FS::cust_bill_pkg \%hash;
  29   $record = new FS::cust_bill_pkg { 'column' => 'value' };
  30
  31   $error = $record->insert;
  32
  33   $error = $record->check;
  34
  35 =head1 DESCRIPTION
  36
  37 An FS::cust_bill_pkg object represents an invoice line item.
  38 FS::cust_bill_pkg inherits from FS::Record.  The following fields are currently
  39 supported:
  40
  41 =over 4
  42
  43 =item billpkgnum - primary key
  44
  45 =item invnum - invoice (see L<FS::cust_bill>)
  46
  47 =item pkgnum - 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)
  48
  49 =item pkgpart_override - optional package definition (see L<FS::part_pkg>) override
  50 =item setup - setup fee
  51
  52 =item recur - recurring fee
  53
  54 =item sdate - starting date of recurring fee
  55
  56 =item edate - ending date of recurring fee
  57
  58 =item itemdesc - Line item description (overrides normal package description)
  59
  60 =item quantity - If not set, defaults to 1
  61
  62 =item unitsetup - If not set, defaults to setup
  63
  64 =item unitrecur - If not set, defaults to recur
  65
  66 =back
  67
  68 sdate and edate are specified as UNIX timestamps; see L<perlfunc/"time">.  Also
  69 see L<Time::Local> and L<Date::Parse> for conversion functions.
  70
  71 =head1 METHODS
  72
  73 =over 4
  74
  75 =item new HASHREF
  76
  77 Creates a new line item.  To add the line item to the database, see
  78 L<"insert">.  Line items are normally created by calling the bill method of a
  79 customer object (see L<FS::cust_main>).
  80
  81 =cut
  82
  83 sub table { 'cust_bill_pkg'; }
  84
  85 =item insert
  86
  87 Adds this line item to the database.  If there is an error, returns the error,
  88 otherwise returns false.
  89
  90 =cut
  91
  92 sub insert {
  93   my $self = shift;
  94
  95   local $SIG{HUP} = 'IGNORE';
  96   local $SIG{INT} = 'IGNORE';
  97   local $SIG{QUIT} = 'IGNORE';
  98   local $SIG{TERM} = 'IGNORE';
  99   local $SIG{TSTP} = 'IGNORE';
 100   local $SIG{PIPE} = 'IGNORE';
 101
 102   my $oldAutoCommit = $FS::UID::AutoCommit;
 103   local $FS::UID::AutoCommit = 0;
 104   my $dbh = dbh;
 105
 106   my $error = $self->SUPER::insert;
 107   if ( $error ) {
 108     $dbh->rollback if $oldAutoCommit;
 109     return $error;
 110   }
 111
 112   if ( defined dbdef->table('cust_bill_pkg_detail') && $self->get('details') ) {
 113     foreach my $detail ( @{$self->get('details')} ) {
 114       my $cust_bill_pkg_detail = new FS::cust_bill_pkg_detail {
 115         'billpkgnum' => $self->billpkgnum,
 116         'format'     => (ref($detail) ? $detail->[0] : '' ),
 117         'detail'     => (ref($detail) ? $detail->[1] : $detail ),
 118         'amount'     => (ref($detail) ? $detail->[2] : '' ),
 119         'classnum'   => (ref($detail) ? $detail->[3] : '' ),
 120       };
 121       $error = $cust_bill_pkg_detail->insert;
 122       if ( $error ) {
 123         $dbh->rollback if $oldAutoCommit;
 124         return $error;
 125       }
 126     }
 127   }
 128
 129   if ( defined dbdef->table('cust_bill_pkg_display') && $self->get('display') ){
 130     foreach my $cust_bill_pkg_display ( @{ $self->get('display') } ) {
 131       $cust_bill_pkg_display->billpkgnum($self->billpkgnum);
 132       $error = $cust_bill_pkg_display->insert;
 133       if ( $error ) {
 134         $dbh->rollback if $oldAutoCommit;
 135         return $error;
 136       }
 137     }
 138   }
 139
 140   if ( $self->_cust_tax_exempt_pkg ) {
 141     foreach my $cust_tax_exempt_pkg ( @{$self->_cust_tax_exempt_pkg} ) {
 142       $cust_tax_exempt_pkg->billpkgnum($self->billpkgnum);
 143       $error = $cust_tax_exempt_pkg->insert;
 144       if ( $error ) {
 145         $dbh->rollback if $oldAutoCommit;
 146         return $error;
 147       }
 148     }
 149   }
 150
 151   my $tax_location = $self->get('cust_bill_pkg_tax_location');
 152   if ( $tax_location ) {
 153     foreach my $cust_bill_pkg_tax_location ( @$tax_location ) {
 154       $cust_bill_pkg_tax_location->billpkgnum($self->billpkgnum);
 155       warn $cust_bill_pkg_tax_location;
 156       $error = $cust_bill_pkg_tax_location->insert;
 157       warn $error;
 158       if ( $error ) {
 159         $dbh->rollback if $oldAutoCommit;
 160         return $error;
 161       }
 162     }
 163   }
 164
 165   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 166   '';
 167
 168 }
 169
 170 =item delete
 171
 172 Currently unimplemented.  I don't remove line items because there would then be
 173 no record the items ever existed (which is bad, no?)
 174
 175 =cut
 176
 177 sub delete {
 178   return "Can't delete cust_bill_pkg records!";
 179 }
 180
 181 #alas, bin/follow-tax-rename
 182 #
 183 #=item replace OLD_RECORD
 184 #
 185 #Currently unimplemented.  This would be even more of an accounting nightmare
 186 #than deleteing the items.  Just don't do it.
 187 #
 188 #=cut
 189 #
 190 #sub replace {
 191 #  return "Can't modify cust_bill_pkg records!";
 192 #}
 193
 194 =item check
 195
 196 Checks all fields to make sure this is a valid line item.  If there is an
 197 error, returns the error, otherwise returns false.  Called by the insert
 198 method.
 199
 200 =cut
 201
 202 sub check {
 203   my $self = shift;
 204
 205   my $error =
 206          $self->ut_numbern('billpkgnum')
 207       || $self->ut_snumber('pkgnum')
 208       || $self->ut_number('invnum')
 209       || $self->ut_money('setup')
 210       || $self->ut_money('recur')
 211       || $self->ut_numbern('sdate')
 212       || $self->ut_numbern('edate')
 213       || $self->ut_textn('itemdesc')
 214   ;
 215   return $error if $error;
 216
 217   #if ( $self->pkgnum != 0 ) { #allow unchecked pkgnum 0 for tax! (add to part_pkg?)
 218   if ( $self->pkgnum > 0 ) { #allow -1 for non-pkg line items and 0 for tax (add to part_pkg?)
 219     return "Unknown pkgnum ". $self->pkgnum
 220       unless qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 221   }
 222
 223   return "Unknown invnum"
 224     unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } );
 225
 226   $self->SUPER::check;
 227 }
 228
 229 =item cust_pkg
 230
 231 Returns the package (see L<FS::cust_pkg>) for this invoice line item.
 232
 233 =cut
 234
 235 sub cust_pkg {
 236   my $self = shift;
 237   qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 238 }
 239
 240 =item part_pkg
 241
 242 Returns the package definition for this invoice line item.
 243
 244 =cut
 245
 246 sub part_pkg {
 247   my $self = shift;
 248   if ( $self->pkgpart_override ) {
 249     qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart_override } );
 250   } else {
 251     $self->cust_pkg->part_pkg;
 252   }
 253 }
 254
 255 =item cust_bill
 256
 257 Returns the invoice (see L<FS::cust_bill>) for this invoice line item.
 258
 259 =cut
 260
 261 sub cust_bill {
 262   my $self = shift;
 263   qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
 264 }
 265
 266 =item details [ OPTION => VALUE ... ]
 267
 268 Returns an array of detail information for the invoice line item.
 269
 270 Currently available options are: I<format> I<escape_function>
 271
 272 If I<format> is set to html or latex then the array members are improved
 273 for tabular appearance in those environments if possible.
 274
 275 If I<escape_function> is set then the array members are processed by this
 276 function before being returned.
 277
 278 =cut
 279
 280 sub details {
 281   my ( $self, %opt ) = @_;
 282   my $format = $opt{format} || '';
 283   my $escape_function = $opt{escape_function} || sub { shift };
 284   return () unless defined dbdef->table('cust_bill_pkg_detail');
 285
 286   eval "use Text::CSV_XS;";
 287   die $@ if $@;
 288   my $csv = new Text::CSV_XS;
 289
 290   my $format_sub = sub { my $detail = shift;
 291                          $csv->parse($detail) or return "can't parse $detail";
 292                          join(' - ', map { &$escape_function($_) }
 293                                      $csv->fields
 294                              );
 295                        };
 296
 297   $format_sub = sub { my $detail = shift;
 298                       $csv->parse($detail) or return "can't parse $detail";
 299                       join('</TD><TD>', map { &$escape_function($_) }
 300                                         $csv->fields
 301                           );
 302                     }
 303     if $format eq 'html';
 304
 305   $format_sub = sub { my $detail = shift;
 306                       $csv->parse($detail) or return "can't parse $detail";
 307                       #join(' & ', map { '\small{'. &$escape_function($_). '}' }
 308                       #            $csv->fields );
 309                       my $result = '';
 310                       my $column = 1;
 311                       foreach ($csv->fields) {
 312                         $result .= ' & ' if $column > 1;
 313                         if ($column > 6) {                     # KLUDGE ALERT!
 314                           $result .= '\multicolumn{1}{l}{\scriptsize{'.
 315                                      &$escape_function($_). '}}';
 316                         }else{
 317                           $result .= '\scriptsize{'.  &$escape_function($_). '}';
 318                         }
 319                         $column++;
 320                       }
 321                       $result;
 322                     }
 323     if $format eq 'latex';
 324
 325   $format_sub = $opt{format_function} if $opt{format_function};
 326
 327   map { ( $_->format eq 'C'
 328           ? &{$format_sub}( $_->detail )
 329           : &{$escape_function}( $_->detail )
 330         )
 331       }
 332     qsearch ({ 'table'    => 'cust_bill_pkg_detail',
 333                'hashref'  => { 'billpkgnum' => $self->billpkgnum },
 334                'order_by' => 'ORDER BY detailnum',
 335             });
 336     #qsearch ( 'cust_bill_pkg_detail', { 'lineitemnum' => $self->lineitemnum });
 337 }
 338
 339 =item desc
 340
 341 Returns a description for this line item.  For typical line items, this is the
 342 I<pkg> field of the corresponding B<FS::part_pkg> object (see L<FS::part_pkg>).
 343 For one-shot line items and named taxes, it is the I<itemdesc> field of this
 344 line item, and for generic taxes, simply returns "Tax".
 345
 346 =cut
 347
 348 sub desc {
 349   my $self = shift;
 350
 351   if ( $self->pkgnum > 0 ) {
 352     $self->itemdesc || $self->part_pkg->pkg;
 353   } else {
 354     $self->itemdesc || 'Tax';
 355   }
 356 }
 357
 358 =item owed_setup
 359
 360 Returns the amount owed (still outstanding) on this line item's setup fee,
 361 which is the amount of the line item minus all payment applications (see
 362 L<FS::cust_bill_pay_pkg> and credit applications (see
 363 L<FS::cust_credit_bill_pkg>).
 364
 365 =cut
 366
 367 sub owed_setup {
 368   my $self = shift;
 369   $self->owed('setup', @_);
 370 }
 371
 372 =item owed_recur
 373
 374 Returns the amount owed (still outstanding) on this line item's recurring fee,
 375 which is the amount of the line item minus all payment applications (see
 376 L<FS::cust_bill_pay_pkg> and credit applications (see
 377 L<FS::cust_credit_bill_pkg>).
 378
 379 =cut
 380
 381 sub owed_recur {
 382   my $self = shift;
 383   $self->owed('recur', @_);
 384 }
 385
 386 # modeled after cust_bill::owed...
 387 sub owed {
 388   my( $self, $field ) = @_;
 389   my $balance = $self->$field();
 390   $balance -= $_->amount foreach ( $self->cust_bill_pay_pkg($field) );
 391   $balance -= $_->amount foreach ( $self->cust_credit_bill_pkg($field) );
 392   $balance = sprintf( '%.2f', $balance );
 393   $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
 394   $balance;
 395 }
 396
 397 sub cust_bill_pay_pkg {
 398   my( $self, $field ) = @_;
 399   qsearch( 'cust_bill_pay_pkg', { 'billpkgnum' => $self->billpkgnum,
 400                                   'setuprecur' => $field,
 401                                 }
 402          );
 403 }
 404
 405 sub cust_credit_bill_pkg {
 406   my( $self, $field ) = @_;
 407   qsearch( 'cust_credit_bill_pkg', { 'billpkgnum' => $self->billpkgnum,
 408                                      'setuprecur' => $field,
 409                                    }
 410          );
 411 }
 412
 413 =item units
 414
 415 Returns the number of billing units (for tax purposes) represented by this,
 416 line item.
 417
 418 =cut
 419
 420 sub units {
 421   my $self = shift;
 422   $self->pkgnum ? $self->part_pkg->calc_units($self->cust_pkg) : 0; # 1?
 423 }
 424
 425 =item quantity
 426
 427 =cut
 428
 429 sub quantity {
 430   my( $self, $value ) = @_;
 431   if ( defined($value) ) {
 432     $self->setfield('quantity', $value);
 433   }
 434   $self->getfield('quantity') || 1;
 435 }
 436
 437 =item unitsetup
 438
 439 =cut
 440
 441 sub unitsetup {
 442   my( $self, $value ) = @_;
 443   if ( defined($value) ) {
 444     $self->setfield('unitsetup', $value);
 445   }
 446   $self->getfield('unitsetup') eq ''
 447     ? $self->getfield('setup')
 448     : $self->getfield('unitsetup');
 449 }
 450
 451 =item unitrecur
 452
 453 =cut
 454
 455 sub unitrecur {
 456   my( $self, $value ) = @_;
 457   if ( defined($value) ) {
 458     $self->setfield('unitrecur', $value);
 459   }
 460   $self->getfield('unitrecur') eq ''
 461     ? $self->getfield('recur')
 462     : $self->getfield('unitrecur');
 463 }
 464
 465 =item disintegrate
 466
 467 Returns a list of cust_bill_pkg objects each with no more than a single class
 468 (including setup or recur) of charge.
 469
 470 =cut
 471
 472 sub disintegrate {
 473   my $self = shift;
 474   # XXX this goes away with cust_bill_pkg refactor
 475
 476   my $cust_bill_pkg = new FS::cust_bill_pkg { $self->hash };
 477   my %cust_bill_pkg = ();
 478
 479   $cust_bill_pkg{setup} = $cust_bill_pkg if $cust_bill_pkg->setup;
 480   $cust_bill_pkg{recur} = $cust_bill_pkg if $cust_bill_pkg->recur;
 481
 482
 483   #split setup and recur
 484   if ($cust_bill_pkg->setup && $cust_bill_pkg->recur) {
 485     my $cust_bill_pkg_recur = new FS::cust_bill_pkg { $cust_bill_pkg->hash };
 486     $cust_bill_pkg->set('details', []);
 487     $cust_bill_pkg->recur(0);
 488     $cust_bill_pkg->unitrecur(0);
 489     $cust_bill_pkg->type('');
 490     $cust_bill_pkg_recur->setup(0);
 491     $cust_bill_pkg_recur->unitsetup(0);
 492     $cust_bill_pkg{recur} = $cust_bill_pkg_recur;
 493
 494   }
 495
 496   #split usage from recur
 497   my $usage = sprintf( "%.2f", $cust_bill_pkg{recur}->usage );
 498   warn "usage is $usage\n" if $DEBUG;
 499   if ($usage) {
 500     my $cust_bill_pkg_usage =
 501         new FS::cust_bill_pkg { $cust_bill_pkg{recur}->hash };
 502     $cust_bill_pkg_usage->recur( $usage );
 503     $cust_bill_pkg_usage->type( 'U' );
 504     my $recur = sprintf( "%.2f", $cust_bill_pkg{recur}->recur - $usage );
 505     $cust_bill_pkg{recur}->recur( $recur );
 506     $cust_bill_pkg{recur}->type( '' );
 507     $cust_bill_pkg{recur}->set('details', []);
 508     $cust_bill_pkg{''} = $cust_bill_pkg_usage;
 509   }
 510
 511   #subdivide usage by usage_class
 512   if (exists($cust_bill_pkg{''})) {
 513     foreach my $class (grep { $_ } $self->usage_classes) {
 514       my $usage = sprintf( "%.2f", $cust_bill_pkg{''}->usage($class) );
 515       my $cust_bill_pkg_usage =
 516           new FS::cust_bill_pkg { $cust_bill_pkg{''}->hash };
 517       $cust_bill_pkg_usage->recur( $usage );
 518       $cust_bill_pkg_usage->set('details', []);
 519       my $classless = sprintf( "%.2f", $cust_bill_pkg{''}->recur - $usage );
 520       $cust_bill_pkg{''}->recur( $classless );
 521       $cust_bill_pkg{$class} = $cust_bill_pkg_usage;
 522     }
 523     delete $cust_bill_pkg{''} unless $cust_bill_pkg{''}->recur;
 524   }
 525
 526 #  # sort setup,recur,'', and the rest numeric && return
 527 #  my @result = map { $cust_bill_pkg{$_} }
 528 #               sort { my $ad = ($a=~/^\d+$/); my $bd = ($b=~/^\d+$/);
 529 #                      ( $ad cmp $bd ) || ( $ad ? $a<=>$b : $b cmp $a )
 530 #                    }
 531 #               keys %cust_bill_pkg;
 532 #
 533 #  return (@result);
 534
 535    %cust_bill_pkg;
 536 }
 537
 538 =item usage CLASSNUM
 539
 540 Returns the amount of the charge associated with usage class CLASSNUM if
 541 CLASSNUM is defined.  Otherwise returns the total charge associated with
 542 usage.
 543
 544 =cut
 545
 546 sub usage {
 547   my( $self, $classnum ) = @_;
 548   my $sum = 0;
 549   my @values = ();
 550
 551   if ( $self->get('details') ) {
 552
 553     @values =
 554       map { $_->[2] }
 555       grep { ref($_) && ( defined($classnum) ? $_->[3] eq $classnum : 1 ) }
 556       @{ $self->get('details') };
 557
 558   }else{
 559
 560     my $hashref = { 'billpkgnum' => $self->billpkgnum };
 561     $hashref->{ 'classnum' } = $classnum if defined($classnum);
 562     @values = map { $_->amount } qsearch('cust_bill_pkg_detail', $hashref);
 563
 564   }
 565
 566   foreach ( @values ) {
 567     $sum += $_ if $_;
 568   }
 569   $sum;
 570 }
 571
 572 =item usage_classes
 573
 574 Returns a list of usage classnums associated with this invoice line's
 575 details.
 576
 577 =cut
 578
 579 sub usage_classes {
 580   my( $self ) = @_;
 581
 582   if ( $self->get('details') ) {
 583
 584     my %seen = ();
 585     foreach my $detail ( grep { ref($_) } @{$self->get('details')} ) {
 586       $seen{ $detail->[3] } = 1;
 587     }
 588     keys %seen;
 589
 590   }else{
 591
 592     map { $_->classnum }
 593         qsearch({ table   => 'cust_bill_pkg_detail',
 594                   hashref => { billpkgnum => $self->billpkgnum },
 595                   select  => 'DISTINCT classnum',
 596                });
 597
 598   }
 599
 600 }
 601
 602 =item cust_bill_pkg_display [ type => TYPE ]
 603
 604 Returns an array of display information for the invoice line item optionally
 605 limited to 'TYPE'.
 606
 607 =cut
 608
 609 sub cust_bill_pkg_display {
 610   my ( $self, %opt ) = @_;
 611
 612   my $default =
 613     new FS::cust_bill_pkg_display { billpkgnum =>$self->billpkgnum };
 614
 615   return ( $default ) unless defined dbdef->table('cust_bill_pkg_display');#hmmm
 616
 617   my $type = $opt{type} if exists $opt{type};
 618   my @result;
 619
 620   if ( scalar( $self->get('display') ) ) {
 621     @result = grep { defined($type) ? ($type eq $_->type) : 1 }
 622               @{ $self->get('display') };
 623   }else{
 624     my $hashref = { 'billpkgnum' => $self->billpkgnum };
 625     $hashref->{type} = $type if defined($type);
 626
 627     @result = qsearch ({ 'table'    => 'cust_bill_pkg_display',
 628                          'hashref'  => { 'billpkgnum' => $self->billpkgnum },
 629                          'order_by' => 'ORDER BY billpkgdisplaynum',
 630                       });
 631   }
 632
 633   push @result, $default unless ( scalar(@result) || $type );
 634
 635   @result;
 636
 637 }
 638
 639 # reserving this name for my friends FS::{tax_rate|cust_main_county}::taxline
 640 # and FS::cust_main::bill
 641
 642 sub _cust_tax_exempt_pkg {
 643   my ( $self ) = @_;
 644
 645   $self->{Hash}->{_cust_tax_exempt_pkg} or
 646   $self->{Hash}->{_cust_tax_exempt_pkg} = [];
 647
 648 }
 649
 650
 651 =back
 652
 653 =head1 BUGS
 654
 655 setup and recur shouldn't be separate fields.  There should be one "amount"
 656 field and a flag to tell you if it is a setup/one-time fee or a recurring fee.
 657
 658 A line item with both should really be two separate records (preserving
 659 sdate and edate for setup fees for recurring packages - that information may
 660 be valuable later).  Invoice generation (cust_main::bill), invoice printing
 661 (cust_bill), tax reports (report_tax.cgi) and line item reports
 662 (cust_bill_pkg.cgi) would need to be updated.
 663
 664 owed_setup and owed_recur could then be repaced by just owed, and
 665 cust_bill::open_cust_bill_pkg and
 666 cust_bill_ApplicationCommon::apply_to_lineitems could be simplified.
 667
 668 =head1 SEE ALSO
 669
 670 L<FS::Record>, L<FS::cust_bill>, L<FS::cust_pkg>, L<FS::cust_main>, schema.html
 671 from the base documentation.
 672
 673 =cut
 674
 675 1;
 676