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