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