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