path: root/FS/FS/part_fee.pm

package FS::part_fee;

use strict;
use base qw( FS::o2m_Common FS::Record );
use vars qw( $DEBUG );
use FS::Record qw( qsearch qsearchs );

$DEBUG = 1;

=head1 NAME

FS::part_fee - Object methods for part_fee records

=head1 SYNOPSIS

  use FS::part_fee;

  $record = new FS::part_fee \%hash;
  $record = new FS::part_fee { 'column' => 'value' };

  $error = $record->insert;

  $error = $new_record->replace($old_record);

  $error = $record->delete;

  $error = $record->check;

=head1 DESCRIPTION

An FS::part_fee object represents the definition of a fee

Fees are like packages, but instead of being ordered and then billed on a 
cycle, they are created by the operation of events and added to a single
invoice.  The fee definition specifies the fee's description, how the amount
is calculated (a flat fee or a percentage of the customer's balance), and 
how to classify the fee for tax and reporting purposes.

FS::part_fee inherits from FS::Record.  The following fields are currently 
supported:

=over 4

=item feepart - primary key

=item comment - a description of the fee for employee use, not shown on 
the invoice

=item disabled - 'Y' if the fee is disabled

=item classnum - the L<FS::pkg_class> that the fee belongs to, for reporting

=item taxable - 'Y' if this fee should be considered a taxable sale.  
Currently, taxable fees will be treated like they exist at the customer's
default service location.

=item taxclass - the tax class the fee belongs to, as a string, for the 
internal tax system

=item taxproductnum - the tax product family the fee belongs to, for the 
external tax system in use, if any

=item pay_weight - Weight (relative to credit_weight and other package/fee 
definitions) that controls payment application to specific line items.

=item credit_weight - Weight that controls credit application to specific
line items.

=item agentnum - the agent (L<FS::agent>) who uses this fee definition.

=item amount - the flat fee to charge, as a decimal amount

=item percent - the percentage of the base to charge (out of 100).  If both
this and "amount" are specified, the fee will be the sum of the two.

=item basis - the method for calculating the base: currently one of "charged",
"owed", or null.

=item minimum - the minimum fee that should be charged

=item maximum - the maximum fee that should be charged

=item limit_credit - 'Y' to set the maximum fee at the customer's credit 
balance, if any.

=item setuprecur - whether the fee should be classified as 'setup' or 
'recur', for reporting purposes.

=back

=head1 METHODS

=over 4

=item new HASHREF

Creates a new fee definition.  To add the record to the database, see 
L<"insert">.

=cut

sub table { 'part_fee'; }

=item insert

Adds this record to the database.  If there is an error, returns the error,
otherwise returns false.

=item delete

Delete this record from the database.

=item replace OLD_RECORD

Replaces the OLD_RECORD with this one in the database.  If there is an error,
returns the error, otherwise returns false.

=item check

Checks all fields to make sure this is a valid example.  If there is
an error, returns the error, otherwise returns false.  Called by the insert
and replace methods.

=cut

sub check {
  my $self = shift;

  my $error = 
    $self->ut_numbern('feepart')
    || $self->ut_textn('comment')
    || $self->ut_flag('disabled')
    || $self->ut_foreign_keyn('classnum', 'pkg_class', 'classnum')
    || $self->ut_flag('taxable')
    || $self->ut_textn('taxclass')
    || $self->ut_numbern('taxproductnum')
    || $self->ut_floatn('pay_weight')
    || $self->ut_floatn('credit_weight')
    || $self->ut_agentnum_acl('agentnum',
                              [ 'Edit global package definitions' ])
    || $self->ut_moneyn('amount')
    || $self->ut_floatn('percent')
    || $self->ut_moneyn('minimum')
    || $self->ut_moneyn('maximum')
    || $self->ut_flag('limit_credit')
    || $self->ut_enum('basis', [ '', 'charged', 'owed' ])
    || $self->ut_enum('setuprecur', [ 'setup', 'recur' ])
  ;
  return $error if $error;

  return "For a percentage fee, the basis must be set"
    if $self->get('percent') > 0 and $self->get('basis') eq '';

  if ( ! $self->get('percent') and ! $self->get('limit_credit') ) {
    # then it makes no sense to apply minimum/maximum
    $self->set('minimum', '');
    $self->set('maximum', '');
  }
  if ( $self->get('limit_credit') ) {
    $self->set('maximum', '');
  }

  $self->SUPER::check;
}

=item explanation

Returns a string describing how this fee is calculated.

=cut

sub explanation {
  my $self = shift;
  # XXX customer currency
  my $money_char = FS::Conf->new->config('money_char') || '$';
  my $money = $money_char . '%.2f';
  my $percent = '%.1f%%';
  my $string;
  if ( $self->amount > 0 ) {
    $string = sprintf($money, $self->amount);
  }
  if ( $self->percent > 0 ) {
    if ( $string ) {
      $string .= " plus ";
    }
    $string .= sprintf($percent, $self->percent);
    $string .= ' of the ';
    if ( $self->basis eq 'charged' ) {
      $string .= 'invoice amount';
    } elsif ( $self->basis('owed') ) {
      $string .= 'unpaid invoice balance';
    }
  }
  if ( $self->minimum or $self->maximum or $self->limit_credit ) {
    $string .= "\nbut";
    if ( $self->minimum ) {
      $string .= ' at least '.sprintf($money, $self->minimum);
    }
    if ( $self->maximum ) {
      $string .= ' and' if $self->minimum;
      $string .= ' at most '.sprintf($money, $self->maximum);
    }
    if ( $self->limit_credit ) {
      if ( $self->maximum ) {
        $string .= ", or the customer's credit balance, whichever is less.";
      } else {
        $string .= ' and' if $self->minimum;
        $string .= " not more than the customer's credit balance";
      }
    }
  }
  return $string;
}

=item lineitem INVOICE

Given INVOICE (an L<FS::cust_bill>), returns an L<FS::cust_bill_pkg> object 
representing the invoice line item for the fee, with linked 
L<FS::cust_bill_pkg_fee> record(s) allocating the fee to the invoice or 
its line items, as appropriate.

=cut

sub lineitem {
  my $self = shift;
  my $cust_bill = shift;

  my $amount = 0 + $self->get('amount');
  my $total_base;  # sum of base line items
  my @items;       # base line items (cust_bill_pkg records)
  my @item_base;   # charged/owed of that item (sequential w/ @items)
  my @item_fee;    # fee amount of that item (sequential w/ @items)
  my @cust_bill_pkg_fee; # link record

  warn "Calculating fee: ".$self->itemdesc." on ".
    ($cust_bill->invnum ? "invoice #".$cust_bill->invnum : "current invoice").
    "\n" if $DEBUG;
  if ( $self->percent > 0 and $self->basis ne '' ) {
    warn $self->percent . "% of amount ".$self->basis.")\n"
      if $DEBUG;

    # $total_base: the total charged/owed on the invoice
    # %item_base: billpkgnum => fraction of base amount
    if ( $cust_bill->invnum ) {
      my $basis = $self->basis;
      $total_base = $cust_bill->$basis; # "charged", "owed"

      # calculate the fee on an already-inserted past invoice.  This may have 
      # payments or credits, so if basis = owed, we need to consider those.
      my $basis_sql = $basis.'_sql';
      my $sql = 'SELECT ' . FS::cust_bill_pkg->$basis_sql .
                ' FROM cust_bill_pkg WHERE billpkgnum = ?';
      @items = $cust_bill->cust_bill_pkg;
      @item_base = map { FS::Record->scalar_sql($sql, $_->billpkgnum) }
                    @items;
    } else {
      # the fee applies to _this_ invoice.  It has no payments or credits, so
      # "charged" and "owed" basis are both just the invoice amount, and 
      # the line item amounts (setup + recur)
      $total_base = $cust_bill->charged;
      @items = @{ $cust_bill->get('cust_bill_pkg') };
      @item_base = map { $_->setup + $_->recur }
                    @items;
    }

    $amount += $total_base * $self->percent / 100;
  }

  if ( $self->minimum ne '' and $amount < $self->minimum ) {
    warn "Applying mininum fee\n" if $DEBUG;
    $amount = $self->minimum;
  }

  my $maximum = $self->maximum;
  if ( $self->limit_credit ) {
    my $balance = $cust_bill->cust_main;
    if ( $balance >= 0 ) {
      $maximum = 0;
    } elsif ( -1 * $balance < $maximum ) {
      $maximum = -1 * $balance;
    }
  }
  if ( $maximum ne '' and $amount > $maximum ) {
    warn "Applying maximum fee\n" if $DEBUG;
    $amount = $maximum;
  }

  # at this point, if the fee is zero, return nothing
  return if $amount < 0.005;
  $amount = sprintf('%.2f', $amount);

  my $cust_bill_pkg = FS::cust_bill_pkg->new({
      feepart     => $self->feepart,
      pkgnum      => 0,
      # no sdate/edate, right?
      setup       => 0,
      recur       => 0,
  });
  $cust_bill_pkg->set( $self->setuprecur, $amount );
  
  if ( $self->classnum ) {
    my $pkg_category = $self->pkg_class->pkg_category;
    $cust_bill_pkg->set('section' => $pkg_category->categoryname)
      if $pkg_category;
  }

  # if this is a percentage fee and has line item fractions,
  # adjust them to be proportional and to add up correctly.
  if ( @item_base ) {
    my $cents = $amount * 100;
    # not necessarily the same as percent
    my $multiplier = $amount / $total_base;
    for (my $i = 0; $i < scalar(@items); $i++) {
      my $fee = sprintf('%.2f', $item_base[$i] * $multiplier);
      $item_fee[$i] = $fee;
      $cents -= $fee * 100;
    }
    # correct rounding error
    while ($cents >= 0.5 or $cents < -0.5) {
      foreach my $fee (@item_fee) {
        if ( $cents >= 0.5 ) {
          $fee += 0.01;
          $cents--;
        } elsif ( $cents < -0.5 ) {
          $fee -= 0.01;
          $cents++;
        }
      }
    }
    # and add them to the cust_bill_pkg
    for (my $i = 0; $i < scalar(@items); $i++) {
      if ( $item_fee[$i] > 0 ) {
        push @cust_bill_pkg_fee, FS::cust_bill_pkg_fee->new({
            cust_bill_pkg   => $cust_bill_pkg,
            base_invnum     => $cust_bill->invnum,
            amount          => $item_fee[$i],
            base_cust_bill_pkg => $items[$i], # late resolve
        });
      }
    }
  } else { # if !@item_base
    # then this isn't a proportional fee, so it just applies to the 
    # entire invoice.
    # (if it's the current invoice, $cust_bill->invnum is null and that 
    # will be fixed later)
    push @cust_bill_pkg_fee, FS::cust_bill_pkg_fee->new({
        cust_bill_pkg   => $cust_bill_pkg,
        base_invnum     => $cust_bill->invnum,
        amount          => $amount,
    });
  }

  # cust_bill_pkg::insert will handle this
  $cust_bill_pkg->set('cust_bill_pkg_fee', \@cust_bill_pkg_fee);
  # avoid misbehavior by usage() and some other things
  $cust_bill_pkg->set('details', []);

  return $cust_bill_pkg;
}

=item itemdesc_locale LOCALE

Returns a customer-viewable description of this fee for the given locale,
from the part_fee_msgcat table.  If the locale is empty or no localized fee
description exists, returns part_fee.itemdesc.

=cut

sub itemdesc_locale {
  my ( $self, $locale ) = @_;
  return $self->itemdesc unless $locale;
  my $part_fee_msgcat = qsearchs('part_fee_msgcat', {
    feepart => $self->feepart,
    locale  => $locale,
  }) or return $self->itemdesc;
  $part_fee_msgcat->itemdesc;
}

=item tax_rates DATA_PROVIDER, GEOCODE

Returns the external taxes (L<FS::tax_rate> objects) that apply to this
fee, in the location specified by GEOCODE.

=cut

sub tax_rates {
  my $self = shift;
  my ($vendor, $geocode) = @_;
  return unless $self->taxproductnum;
  my $taxproduct = FS::part_pkg_taxproduct->by_key($self->taxproductnum);
  # cch stuff
  my @taxclassnums = map { $_->taxclassnum }
                     $taxproduct->part_pkg_taxrate($geocode);
  return unless @taxclassnums;

  warn "Found taxclassnum values of ". join(',', @taxclassnums) ."\n"
  if $DEBUG;
  my $extra_sql = "AND taxclassnum IN (". join(',', @taxclassnums) . ")";
  my @taxes = qsearch({ 'table'     => 'tax_rate',
      'hashref'   => { 'geocode'     => $geocode,
        'data_vendor' => $vendor },
      'extra_sql' => $extra_sql,
    });
  warn "Found taxes ". join(',', map {$_->taxnum} @taxes) ."\n"
  if $DEBUG;

  return @taxes;
}

sub part_pkg_taxoverride {} # we don't do overrides here

sub has_taxproduct {
  my $self = shift;
  return ($self->taxproductnum ? 1 : 0);
}

=back

=head1 BUGS

=head1 SEE ALSO

L<FS::Record>

=cut

1;