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