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 = 1;
   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
 131   my $error =
 132     $self->ut_numbern('feepart')
 133     || $self->ut_textn('comment')
 134     || $self->ut_flag('disabled')
 135     || $self->ut_foreign_keyn('classnum', 'pkg_class', 'classnum')
 136     || $self->ut_flag('taxable')
 137     || $self->ut_textn('taxclass')
 138     || $self->ut_numbern('taxproductnum')
 139     || $self->ut_floatn('pay_weight')
 140     || $self->ut_floatn('credit_weight')
 141     || $self->ut_agentnum_acl('agentnum',
 142                               [ 'Edit global package definitions' ])
 143     || $self->ut_moneyn('amount')
 144     || $self->ut_floatn('percent')
 145     || $self->ut_moneyn('minimum')
 146     || $self->ut_moneyn('maximum')
 147     || $self->ut_flag('limit_credit')
 148     || $self->ut_enum('basis', [ '', 'charged', 'owed' ])
 149     || $self->ut_enum('setuprecur', [ 'setup', 'recur' ])
 150   ;
 151   return $error if $error;
 152
 153   return "For a percentage fee, the basis must be set"
 154     if $self->get('percent') > 0 and $self->get('basis') eq '';
 155
 156   if ( ! $self->get('percent') and ! $self->get('limit_credit') ) {
 157     # then it makes no sense to apply minimum/maximum
 158     $self->set('minimum', '');
 159     $self->set('maximum', '');
 160   }
 161   if ( $self->get('limit_credit') ) {
 162     $self->set('maximum', '');
 163   }
 164
 165   $self->SUPER::check;
 166 }
 167
 168 =item explanation
 169
 170 Returns a string describing how this fee is calculated.
 171
 172 =cut
 173
 174 sub explanation {
 175   my $self = shift;
 176   # XXX customer currency
 177   my $money_char = FS::Conf->new->config('money_char') || '$';
 178   my $money = $money_char . '%.2f';
 179   my $percent = '%.1f%%';
 180   my $string;
 181   if ( $self->amount > 0 ) {
 182     $string = sprintf($money, $self->amount);
 183   }
 184   if ( $self->percent > 0 ) {
 185     if ( $string ) {
 186       $string .= " plus ";
 187     }
 188     $string .= sprintf($percent, $self->percent);
 189     $string .= ' of the ';
 190     if ( $self->basis eq 'charged' ) {
 191       $string .= 'invoice amount';
 192     } elsif ( $self->basis('owed') ) {
 193       $string .= 'unpaid invoice balance';
 194     }
 195   }
 196   if ( $self->minimum or $self->maximum or $self->limit_credit ) {
 197     $string .= "\nbut";
 198     if ( $self->minimum ) {
 199       $string .= ' at least '.sprintf($money, $self->minimum);
 200     }
 201     if ( $self->maximum ) {
 202       $string .= ' and' if $self->minimum;
 203       $string .= ' at most '.sprintf($money, $self->maximum);
 204     }
 205     if ( $self->limit_credit ) {
 206       if ( $self->maximum ) {
 207         $string .= ", or the customer's credit balance, whichever is less.";
 208       } else {
 209         $string .= ' and' if $self->minimum;
 210         $string .= " not more than the customer's credit balance";
 211       }
 212     }
 213   }
 214   return $string;
 215 }
 216
 217 =item lineitem INVOICE
 218
 219 Given INVOICE (an L<FS::cust_bill>), returns an L<FS::cust_bill_pkg> object
 220 representing the invoice line item for the fee, with linked
 221 L<FS::cust_bill_pkg_fee> record(s) allocating the fee to the invoice or
 222 its line items, as appropriate.
 223
 224 If the fee is going to be charged on the upcoming invoice (credit card
 225 processing fees, postal invoice fees), INVOICE should be an uninserted
 226 L<FS::cust_bill> object where the 'cust_bill_pkg' property is an arrayref
 227 of the non-fee line items that will appear on the invoice.
 228
 229 =cut
 230
 231 sub lineitem {
 232   my $self = shift;
 233   my $cust_bill = shift;
 234   my $cust_main = $cust_bill->cust_main;
 235
 236   my $amount = 0 + $self->get('amount');
 237   my $total_base;  # sum of base line items
 238   my @items;       # base line items (cust_bill_pkg records)
 239   my @item_base;   # charged/owed of that item (sequential w/ @items)
 240   my @item_fee;    # fee amount of that item (sequential w/ @items)
 241   my @cust_bill_pkg_fee; # link record
 242
 243   warn "Calculating fee: ".$self->itemdesc." on ".
 244     ($cust_bill->invnum ? "invoice #".$cust_bill->invnum : "current invoice").
 245     "\n" if $DEBUG;
 246   if ( $self->percent > 0 and $self->basis ne '' ) {
 247     warn $self->percent . "% of amount ".$self->basis.")\n"
 248       if $DEBUG;
 249
 250     # $total_base: the total charged/owed on the invoice
 251     # %item_base: billpkgnum => fraction of base amount
 252     if ( $cust_bill->invnum ) {
 253       my $basis = $self->basis;
 254       $total_base = $cust_bill->$basis; # "charged", "owed"
 255
 256       # calculate the fee on an already-inserted past invoice.  This may have
 257       # payments or credits, so if basis = owed, we need to consider those.
 258       my $basis_sql = $basis.'_sql';
 259       my $sql = 'SELECT ' . FS::cust_bill_pkg->$basis_sql .
 260                 ' FROM cust_bill_pkg WHERE billpkgnum = ?';
 261       @items = $cust_bill->cust_bill_pkg;
 262       @item_base = map { FS::Record->scalar_sql($sql, $_->billpkgnum) }
 263                     @items;
 264     } else {
 265       # the fee applies to _this_ invoice.  It has no payments or credits, so
 266       # "charged" and "owed" basis are both just the invoice amount, and
 267       # the line item amounts (setup + recur)
 268       $total_base = $cust_bill->charged;
 269       @items = @{ $cust_bill->get('cust_bill_pkg') };
 270       @item_base = map { $_->setup + $_->recur }
 271                     @items;
 272     }
 273
 274     $amount += $total_base * $self->percent / 100;
 275   }
 276
 277   if ( $self->minimum ne '' and $amount < $self->minimum ) {
 278     warn "Applying mininum fee\n" if $DEBUG;
 279     $amount = $self->minimum;
 280   }
 281
 282   my $maximum = $self->maximum;
 283   if ( $self->limit_credit ) {
 284     my $balance = $cust_bill->cust_main->balance;
 285     if ( $balance >= 0 ) {
 286       warn "Credit balance is zero, so fee is zero" if $DEBUG;
 287       return; # don't bother doing estimated tax, etc.
 288     } elsif ( -1 * $balance < $maximum ) {
 289       $maximum = -1 * $balance;
 290     }
 291   }
 292   if ( $maximum ne '' ) {
 293     warn "Applying maximum fee\n" if $DEBUG;
 294     $amount = $maximum;
 295   }
 296
 297   # at this point, if the fee is zero, return nothing
 298   return if $amount < 0.005;
 299   $amount = sprintf('%.2f', $amount);
 300
 301   my $cust_bill_pkg = FS::cust_bill_pkg->new({
 302       feepart     => $self->feepart,
 303       pkgnum      => 0,
 304       # no sdate/edate, right?
 305       setup       => 0,
 306       recur       => 0,
 307   });
 308
 309   if ( $maximum and $self->taxable ) {
 310     warn "Estimating taxes on fee.\n";
 311     # then we need to estimate tax to respect the maximum
 312     # XXX currently doesn't work with external (tax_rate) taxes
 313     # or batch taxes, obviously
 314     my $taxlisthash = {};
 315     my $error = $cust_main->_handle_taxes(
 316       $taxlisthash,
 317       $cust_bill_pkg,
 318       location => $cust_main->ship_location
 319     );
 320     my $total_rate = 0;
 321     # $taxlisthash: tax identifier => [ cust_main_county, cust_bill_pkg... ]
 322     my @taxes = map { $_->[0] } values %$taxlisthash;
 323     foreach (@taxes) {
 324       $total_rate += $_->tax;
 325     }
 326     if ($total_rate > 0) {
 327       my $max_cents = $maximum * 100;
 328       my $charge_cents = sprintf('%0.f', $max_cents * 100/(100 + $total_rate));
 329       $maximum = sprintf('%.2f', $charge_cents / 100.00);
 330       $amount = $maximum if $amount > $maximum;
 331     }
 332   } # if $maximum and $self->taxable
 333
 334   # set the amount that we'll charge
 335   $cust_bill_pkg->set( $self->setuprecur, $amount );
 336
 337   if ( $self->classnum ) {
 338     my $pkg_category = $self->pkg_class->pkg_category;
 339     $cust_bill_pkg->set('section' => $pkg_category->categoryname)
 340       if $pkg_category;
 341   }
 342
 343   # if this is a percentage fee and has line item fractions,
 344   # adjust them to be proportional and to add up correctly.
 345   if ( @item_base ) {
 346     my $cents = $amount * 100;
 347     # not necessarily the same as percent
 348     my $multiplier = $amount / $total_base;
 349     for (my $i = 0; $i < scalar(@items); $i++) {
 350       my $fee = sprintf('%.2f', $item_base[$i] * $multiplier);
 351       $item_fee[$i] = $fee;
 352       $cents -= $fee * 100;
 353     }
 354     # correct rounding error
 355     while ($cents >= 0.5 or $cents < -0.5) {
 356       foreach my $fee (@item_fee) {
 357         if ( $cents >= 0.5 ) {
 358           $fee += 0.01;
 359           $cents--;
 360         } elsif ( $cents < -0.5 ) {
 361           $fee -= 0.01;
 362           $cents++;
 363         }
 364       }
 365     }
 366     # and add them to the cust_bill_pkg
 367     for (my $i = 0; $i < scalar(@items); $i++) {
 368       if ( $item_fee[$i] > 0 ) {
 369         push @cust_bill_pkg_fee, FS::cust_bill_pkg_fee->new({
 370             cust_bill_pkg   => $cust_bill_pkg,
 371             base_invnum     => $cust_bill->invnum,
 372             amount          => $item_fee[$i],
 373             base_cust_bill_pkg => $items[$i], # late resolve
 374         });
 375       }
 376     }
 377   } else { # if !@item_base
 378     # then this isn't a proportional fee, so it just applies to the
 379     # entire invoice.
 380     # (if it's the current invoice, $cust_bill->invnum is null and that
 381     # will be fixed later)
 382     push @cust_bill_pkg_fee, FS::cust_bill_pkg_fee->new({
 383         cust_bill_pkg   => $cust_bill_pkg,
 384         base_invnum     => $cust_bill->invnum,
 385         amount          => $amount,
 386     });
 387   }
 388
 389   # cust_bill_pkg::insert will handle this
 390   $cust_bill_pkg->set('cust_bill_pkg_fee', \@cust_bill_pkg_fee);
 391   # avoid misbehavior by usage() and some other things
 392   $cust_bill_pkg->set('details', []);
 393
 394   return $cust_bill_pkg;
 395 }
 396
 397 =item itemdesc_locale LOCALE
 398
 399 Returns a customer-viewable description of this fee for the given locale,
 400 from the part_fee_msgcat table.  If the locale is empty or no localized fee
 401 description exists, returns part_fee.itemdesc.
 402
 403 =cut
 404
 405 sub itemdesc_locale {
 406   my ( $self, $locale ) = @_;
 407   return $self->itemdesc unless $locale;
 408   my $part_fee_msgcat = qsearchs('part_fee_msgcat', {
 409     feepart => $self->feepart,
 410     locale  => $locale,
 411   }) or return $self->itemdesc;
 412   $part_fee_msgcat->itemdesc;
 413 }
 414
 415 =item tax_rates DATA_PROVIDER, GEOCODE
 416
 417 Returns the external taxes (L<FS::tax_rate> objects) that apply to this
 418 fee, in the location specified by GEOCODE.
 419
 420 =cut
 421
 422 sub tax_rates {
 423   my $self = shift;
 424   my ($vendor, $geocode) = @_;
 425   return unless $self->taxproductnum;
 426   my $taxproduct = FS::part_pkg_taxproduct->by_key($self->taxproductnum);
 427   # cch stuff
 428   my @taxclassnums = map { $_->taxclassnum }
 429                      $taxproduct->part_pkg_taxrate($geocode);
 430   return unless @taxclassnums;
 431
 432   warn "Found taxclassnum values of ". join(',', @taxclassnums) ."\n"
 433   if $DEBUG;
 434   my $extra_sql = "AND taxclassnum IN (". join(',', @taxclassnums) . ")";
 435   my @taxes = qsearch({ 'table'     => 'tax_rate',
 436       'hashref'   => { 'geocode'     => $geocode,
 437         'data_vendor' => $vendor },
 438       'extra_sql' => $extra_sql,
 439     });
 440   warn "Found taxes ". join(',', map {$_->taxnum} @taxes) ."\n"
 441   if $DEBUG;
 442
 443   return @taxes;
 444 }
 445
 446 sub part_pkg_taxoverride {} # we don't do overrides here
 447
 448 sub has_taxproduct {
 449   my $self = shift;
 450   return ($self->taxproductnum ? 1 : 0);
 451 }
 452
 453 =back
 454
 455 =head1 BUGS
 456
 457 =head1 SEE ALSO
 458
 459 L<FS::Record>
 460
 461 =cut
 462
 463 1;
 464