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