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