FS/FS/cust_bill_pkg.pm

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