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