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