FS/FS/part_fee.pm

   1 package FS::part_fee;
   2
   3 use strict;
   4 use base qw( FS::o2m_Common FS::Record );
   5 use vars qw( $DEBUG );
   6 use FS::Record qw( qsearch qsearchs );
   7 use FS::pkg_class;
   8 use FS::part_pkg_taxproduct;
   9 use FS::agent;
  10 use FS::part_fee_usage;
  11
  12 $DEBUG = 0;
  13
  14 =head1 NAME
  15
  16 FS::part_fee - Object methods for part_fee records
  17
  18 =head1 SYNOPSIS
  19
  20   use FS::part_fee;
  21
  22   $record = new FS::part_fee \%hash;
  23   $record = new FS::part_fee { 'column' => 'value' };
  24
  25   $error = $record->insert;
  26
  27   $error = $new_record->replace($old_record);
  28
  29   $error = $record->delete;
  30
  31   $error = $record->check;
  32
  33 =head1 DESCRIPTION
  34
  35 An FS::part_fee object represents the definition of a fee
  36
  37 Fees are like packages, but instead of being ordered and then billed on a
  38 cycle, they are created by the operation of events and added to a single
  39 invoice.  The fee definition specifies the fee's description, how the amount
  40 is calculated (a flat fee or a percentage of the customer's balance), and
  41 how to classify the fee for tax and reporting purposes.
  42
  43 FS::part_fee inherits from FS::Record.  The following fields are currently
  44 supported:
  45
  46 =over 4
  47
  48 =item feepart - primary key
  49
  50 =item comment - a description of the fee for employee use, not shown on
  51 the invoice
  52
  53 =item disabled - 'Y' if the fee is disabled
  54
  55 =item classnum - the L<FS::pkg_class> that the fee belongs to, for reporting
  56
  57 =item taxable - 'Y' if this fee should be considered a taxable sale.
  58 Currently, taxable fees will be treated like they exist at the customer's
  59 default service location.
  60
  61 =item taxclass - the tax class the fee belongs to, as a string, for the
  62 internal tax system
  63
  64 =item taxproductnum - the tax product family the fee belongs to, for the
  65 external tax system in use, if any
  66
  67 =item pay_weight - Weight (relative to credit_weight and other package/fee
  68 definitions) that controls payment application to specific line items.
  69
  70 =item credit_weight - Weight that controls credit application to specific
  71 line items.
  72
  73 =item agentnum - the agent (L<FS::agent>) who uses this fee definition.
  74
  75 =item amount - the flat fee to charge, as a decimal amount
  76
  77 =item percent - the percentage of the base to charge (out of 100).  If both
  78 this and "amount" are specified, the fee will be the sum of the two.
  79
  80 =item basis - the method for calculating the base: currently one of "charged",
  81 "owed", or null.
  82
  83 =item minimum - the minimum fee that should be charged
  84
  85 =item maximum - the maximum fee that should be charged
  86
  87 =item limit_credit - 'Y' to set the maximum fee at the customer's credit
  88 balance, if any.
  89
  90 =item setuprecur - whether the fee should be classified as 'setup' or
  91 'recur', for reporting purposes.
  92
  93 =back
  94
  95 =head1 METHODS
  96
  97 =over 4
  98
  99 =item new HASHREF
 100
 101 Creates a new fee definition.  To add the record to the database, see
 102 L<"insert">.
 103
 104 =cut
 105
 106 sub table { 'part_fee'; }
 107
 108 =item insert
 109
 110 Adds this record to the database.  If there is an error, returns the error,
 111 otherwise returns false.
 112
 113 =item delete
 114
 115 Delete this record from the database.
 116
 117 =item replace OLD_RECORD
 118
 119 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 120 returns the error, otherwise returns false.
 121
 122 =item check
 123
 124 Checks all fields to make sure this is a valid example.  If there is
 125 an error, returns the error, otherwise returns false.  Called by the insert
 126 and replace methods.
 127
 128 =cut
 129
 130 sub check {
 131   my $self = shift;
 132
 133   $self->set('amount', 0) unless $self->amount;
 134   $self->set('percent', 0) unless $self->percent;
 135
 136   my $error =
 137     $self->ut_numbern('feepart')
 138     || $self->ut_textn('comment')
 139     || $self->ut_flag('disabled')
 140     || $self->ut_foreign_keyn('classnum', 'pkg_class', 'classnum')
 141     || $self->ut_flag('taxable')
 142     || $self->ut_textn('taxclass')
 143     || $self->ut_numbern('taxproductnum')
 144     || $self->ut_floatn('pay_weight')
 145     || $self->ut_floatn('credit_weight')
 146     || $self->ut_agentnum_acl('agentnum',
 147                               [ 'Edit global package definitions' ])
 148     || $self->ut_money('amount')
 149     || $self->ut_float('percent')
 150     || $self->ut_moneyn('minimum')
 151     || $self->ut_moneyn('maximum')
 152     || $self->ut_flag('limit_credit')
 153     || $self->ut_enum('basis', [ 'charged', 'owed', 'usage' ])
 154     || $self->ut_enum('setuprecur', [ 'setup', 'recur' ])
 155   ;
 156   return $error if $error;
 157
 158   if ( $self->get('limit_credit') ) {
 159     $self->set('maximum', '');
 160   }
 161
 162   if ( $self->get('basis') eq 'usage' ) {
 163     # to avoid confusion, don't also allow charging a percentage
 164     $self->set('percent', 0);
 165   }
 166
 167   $self->SUPER::check;
 168 }
 169
 170 =item explanation
 171
 172 Returns a string describing how this fee is calculated.
 173
 174 =cut
 175
 176 sub explanation {
 177   my $self = shift;
 178   # XXX customer currency
 179   my $money_char = FS::Conf->new->config('money_char') || '$';
 180   my $money = $money_char . '%.2f';
 181   my $percent = '%.1f%%';
 182   my $string = '';
 183   if ( $self->amount > 0 ) {
 184     $string = sprintf($money, $self->amount);
 185   }
 186   if ( $self->percent > 0 ) {
 187     if ( $string ) {
 188       $string .= " plus ";
 189     }
 190     $string .= sprintf($percent, $self->percent);
 191     $string .= ' of the ';
 192     if ( $self->basis eq 'charged' ) {
 193       $string .= 'invoice amount';
 194     } elsif ( $self->basis('owed') ) {
 195       $string .= 'unpaid invoice balance';
 196     }
 197   } elsif ( $self->basis eq 'usage' ) {
 198     if ( $string ) {
 199       $string .= " plus \n";
 200     }
 201     # append per-class descriptions
 202     $string .= join("\n", map { $_->explanation } $self->part_fee_usage);
 203   }
 204
 205   if ( $self->minimum or $self->maximum or $self->limit_credit ) {
 206     $string .= "\nbut";
 207     if ( $self->minimum ) {
 208       $string .= ' at least '.sprintf($money, $self->minimum);
 209     }
 210     if ( $self->maximum ) {
 211       $string .= ' and' if $self->minimum;
 212       $string .= ' at most '.sprintf($money, $self->maximum);
 213     }
 214     if ( $self->limit_credit ) {
 215       if ( $self->maximum ) {
 216         $string .= ", or the customer's credit balance, whichever is less.";
 217       } else {
 218         $string .= ' and' if $self->minimum;
 219         $string .= " not more than the customer's credit balance";
 220       }
 221     }
 222   }
 223   return $string;
 224 }
 225
 226 =item lineitem INVOICE
 227
 228 Given INVOICE (an L<FS::cust_bill>), returns an L<FS::cust_bill_pkg> object
 229 representing the invoice line item for the fee, with linked
 230 L<FS::cust_bill_pkg_fee> record(s) allocating the fee to the invoice or
 231 its line items, as appropriate.
 232
 233 If the fee is going to be charged on the upcoming invoice (credit card
 234 processing fees, postal invoice fees), INVOICE should be an uninserted
 235 L<FS::cust_bill> object where the 'cust_bill_pkg' property is an arrayref
 236 of the non-fee line items that will appear on the invoice.
 237
 238 =cut
 239
 240 sub lineitem {
 241   my $self = shift;
 242   my $cust_bill = shift;
 243   my $cust_main = $cust_bill->cust_main;
 244
 245   my $amount = 0 + $self->get('amount');
 246   my $total_base;  # sum of base line items
 247   my @items;       # base line items (cust_bill_pkg records)
 248   my @item_base;   # charged/owed of that item (sequential w/ @items)
 249   my @item_fee;    # fee amount of that item (sequential w/ @items)
 250   my @cust_bill_pkg_fee; # link record
 251
 252   warn "Calculating fee: ".$self->itemdesc." on ".
 253     ($cust_bill->invnum ? "invoice #".$cust_bill->invnum : "current invoice").
 254     "\n" if $DEBUG;
 255   my $basis = $self->basis;
 256
 257   # $total_base: the total charged/owed on the invoice
 258   # %item_base: billpkgnum => fraction of base amount
 259   if ( $cust_bill->invnum ) {
 260
 261     # calculate the fee on an already-inserted past invoice.  This may have
 262     # payments or credits, so if basis = owed, we need to consider those.
 263     @items = $cust_bill->cust_bill_pkg;
 264     if ( $basis ne 'usage' ) {
 265
 266       $total_base = $cust_bill->$basis; # "charged", "owed"
 267       my $basis_sql = $basis.'_sql';
 268       my $sql = 'SELECT ' . FS::cust_bill_pkg->$basis_sql .
 269                 ' FROM cust_bill_pkg WHERE billpkgnum = ?';
 270       @item_base = map { FS::Record->scalar_sql($sql, $_->billpkgnum) }
 271                     @items;
 272
 273       $amount += $total_base * $self->percent / 100;
 274     }
 275   } else {
 276     # the fee applies to _this_ invoice.  It has no payments or credits, so
 277     # "charged" and "owed" basis are both just the invoice amount, and
 278     # the line item amounts (setup + recur)
 279     @items = @{ $cust_bill->get('cust_bill_pkg') };
 280     if ( $basis ne 'usage' ) {
 281       $total_base = $cust_bill->charged;
 282       @item_base = map { $_->setup + $_->recur }
 283                     @items;
 284
 285       $amount += $total_base * $self->percent / 100;
 286     }
 287   }
 288
 289   if ( $basis eq 'usage' ) {
 290
 291     my %part_fee_usage = map { $_->classnum => $_ } $self->part_fee_usage;
 292
 293     foreach my $item (@items) { # cust_bill_pkg objects
 294       my $usage_fee = 0;
 295       $item->regularize_details;
 296       my $details;
 297       if ( $item->billpkgnum ) {
 298         $details = [
 299           qsearch('cust_bill_pkg_detail', { billpkgnum => $item->billpkgnum })
 300         ];
 301       } else {
 302         $details = $item->get('details') || [];
 303       }
 304       foreach my $d (@$details) {
 305         # if there's a usage fee defined for this class...
 306         next if $d->amount eq '' # not a real usage detail
 307              or $d->amount == 0  # zero charge, probably shouldn't charge fee
 308         ;
 309         my $p = $part_fee_usage{$d->classnum} or next;
 310         $usage_fee += ($d->amount * $p->percent / 100)
 311                     + $p->amount;
 312         # we'd create detail records here if we were doing that
 313       }
 314       # bypass @item_base entirely
 315       push @item_fee, $usage_fee;
 316       $amount += $usage_fee;
 317     }
 318
 319   } # if $basis eq 'usage'
 320
 321   if ( $self->minimum ne '' and $amount < $self->minimum ) {
 322     warn "Applying mininum fee\n" if $DEBUG;
 323     $amount = $self->minimum;
 324   }
 325
 326   my $maximum = $self->maximum;
 327   if ( $self->limit_credit ) {
 328     my $balance = $cust_bill->cust_main->balance;
 329     if ( $balance >= 0 ) {
 330       warn "Credit balance is zero, so fee is zero" if $DEBUG;
 331       return; # don't bother doing estimated tax, etc.
 332     } elsif ( -1 * $balance < $maximum ) {
 333       $maximum = -1 * $balance;
 334     }
 335   }
 336   if ( $maximum ne '' and $amount > $maximum ) {
 337     warn "Applying maximum fee\n" if $DEBUG;
 338     $amount = $maximum;
 339   }
 340
 341   # at this point, if the fee is zero, return nothing
 342   return if $amount < 0.005;
 343   $amount = sprintf('%.2f', $amount);
 344
 345   my $cust_bill_pkg = FS::cust_bill_pkg->new({
 346       feepart     => $self->feepart,
 347       pkgnum      => 0,
 348       # no sdate/edate, right?
 349       setup       => 0,
 350       recur       => 0,
 351   });
 352
 353   if ( $maximum and $self->taxable ) {
 354     warn "Estimating taxes on fee.\n" if $DEBUG;
 355     # then we need to estimate tax to respect the maximum
 356     # XXX currently doesn't work with external (tax_rate) taxes
 357     # or batch taxes, obviously
 358     my $taxlisthash = {};
 359     my $error = $cust_main->_handle_taxes(
 360       $taxlisthash,
 361       $cust_bill_pkg,
 362       location => $cust_main->ship_location
 363     );
 364     my $total_rate = 0;
 365     # $taxlisthash: tax identifier => [ cust_main_county, cust_bill_pkg... ]
 366     my @taxes = map { $_->[0] } values %$taxlisthash;
 367     foreach (@taxes) {
 368       $total_rate += $_->tax;
 369     }
 370     if ($total_rate > 0) {
 371       my $max_cents = $maximum * 100;
 372       my $charge_cents = sprintf('%0.f', $max_cents * 100/(100 + $total_rate));
 373       # the actual maximum that we can charge...
 374       $maximum = sprintf('%.2f', $charge_cents / 100.00);
 375       $amount = $maximum if $amount > $maximum;
 376     }
 377   } # if $maximum and $self->taxable
 378
 379   # set the amount that we'll charge
 380   $cust_bill_pkg->set( $self->setuprecur, $amount );
 381
 382   if ( $self->classnum ) {
 383     my $pkg_category = $self->pkg_class->pkg_category;
 384     $cust_bill_pkg->set('section' => $pkg_category->categoryname)
 385       if $pkg_category;
 386   }
 387
 388   # if this is a percentage fee and has line item fractions,
 389   # adjust them to be proportional and to add up correctly.
 390   if ( @item_base ) {
 391     my $cents = $amount * 100;
 392     # not necessarily the same as percent
 393     my $multiplier = $amount / $total_base;
 394     for (my $i = 0; $i < scalar(@items); $i++) {
 395       my $fee = sprintf('%.2f', $item_base[$i] * $multiplier);
 396       $item_fee[$i] = $fee;
 397       $cents -= $fee * 100;
 398     }
 399     # correct rounding error
 400     while ($cents >= 0.5 or $cents < -0.5) {
 401       foreach my $fee (@item_fee) {
 402         if ( $cents >= 0.5 ) {
 403           $fee += 0.01;
 404           $cents--;
 405         } elsif ( $cents < -0.5 ) {
 406           $fee -= 0.01;
 407           $cents++;
 408         }
 409       }
 410     }
 411   }
 412   if ( @item_fee ) {
 413     # add allocation records to the cust_bill_pkg
 414     for (my $i = 0; $i < scalar(@items); $i++) {
 415       if ( $item_fee[$i] > 0 ) {
 416         push @cust_bill_pkg_fee, FS::cust_bill_pkg_fee->new({
 417             cust_bill_pkg   => $cust_bill_pkg,
 418             base_invnum     => $cust_bill->invnum, # may be null
 419             amount          => $item_fee[$i],
 420             base_cust_bill_pkg => $items[$i], # late resolve
 421         });
 422       }
 423     }
 424   } else { # if !@item_fee
 425     # then this isn't a proportional fee, so it just applies to the
 426     # entire invoice.
 427     push @cust_bill_pkg_fee, FS::cust_bill_pkg_fee->new({
 428         cust_bill_pkg   => $cust_bill_pkg,
 429         base_invnum     => $cust_bill->invnum, # may be null
 430         amount          => $amount,
 431     });
 432   }
 433
 434   # cust_bill_pkg::insert will handle this
 435   $cust_bill_pkg->set('cust_bill_pkg_fee', \@cust_bill_pkg_fee);
 436   # avoid misbehavior by usage() and some other things
 437   $cust_bill_pkg->set('details', []);
 438
 439   return $cust_bill_pkg;
 440 }
 441
 442 =item itemdesc_locale LOCALE
 443
 444 Returns a customer-viewable description of this fee for the given locale,
 445 from the part_fee_msgcat table.  If the locale is empty or no localized fee
 446 description exists, returns part_fee.itemdesc.
 447
 448 =cut
 449
 450 sub itemdesc_locale {
 451   my ( $self, $locale ) = @_;
 452   return $self->itemdesc unless $locale;
 453   my $part_fee_msgcat = qsearchs('part_fee_msgcat', {
 454     feepart => $self->feepart,
 455     locale  => $locale,
 456   }) or return $self->itemdesc;
 457   $part_fee_msgcat->itemdesc;
 458 }
 459
 460 =item tax_rates DATA_PROVIDER, GEOCODE
 461
 462 Returns the external taxes (L<FS::tax_rate> objects) that apply to this
 463 fee, in the location specified by GEOCODE.
 464
 465 =cut
 466
 467 sub tax_rates {
 468   my $self = shift;
 469   my ($vendor, $geocode) = @_;
 470   return unless $self->taxproductnum;
 471   my $taxproduct = FS::part_pkg_taxproduct->by_key($self->taxproductnum);
 472   # cch stuff
 473   my @taxclassnums = map { $_->taxclassnum }
 474                      $taxproduct->part_pkg_taxrate($geocode);
 475   return unless @taxclassnums;
 476
 477   warn "Found taxclassnum values of ". join(',', @taxclassnums) ."\n"
 478   if $DEBUG;
 479   my $extra_sql = "AND taxclassnum IN (". join(',', @taxclassnums) . ")";
 480   my @taxes = qsearch({ 'table'     => 'tax_rate',
 481       'hashref'   => { 'geocode'     => $geocode,
 482         'data_vendor' => $vendor },
 483       'extra_sql' => $extra_sql,
 484     });
 485   warn "Found taxes ". join(',', map {$_->taxnum} @taxes) ."\n"
 486   if $DEBUG;
 487
 488   return @taxes;
 489 }
 490
 491 sub part_pkg_taxoverride {} # we don't do overrides here
 492
 493 sub has_taxproduct {
 494   my $self = shift;
 495   return ($self->taxproductnum ? 1 : 0);
 496 }
 497
 498 # stubs that will go away under 4.x
 499
 500 sub pkg_class {
 501   my $self = shift;
 502   $self->classnum
 503     ? FS::pkg_class->by_key($self->classnum)
 504     : undef;
 505 }
 506
 507 sub part_pkg_taxproduct {
 508   my $self = shift;
 509   $self->taxproductnum
 510     ? FS::part_pkg_taxproduct->by_key($self->taxproductnum)
 511     : undef;
 512 }
 513
 514 sub agent {
 515   my $self = shift;
 516   $self->agentnum
 517     ? FS::agent->by_key($self->agentnum)
 518     : undef;
 519 }
 520
 521 sub part_fee_msgcat {
 522   my $self = shift;
 523   qsearch( 'part_fee_msgcat', { feepart => $self->feepart } );
 524 }
 525
 526 sub part_fee_usage {
 527   my $self = shift;
 528   qsearch( 'part_fee_usage', { feepart => $self->feepart } );
 529 }
 530
 531 =back
 532
 533 =head1 BUGS
 534
 535 =head1 SEE ALSO
 536
 537 L<FS::Record>
 538
 539 =cut
 540
 541 1;
 542