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