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