non-package fees, phase 1, #25899
[freeside.git] / FS / FS / part_fee.pm
diff --git a/FS/FS/part_fee.pm b/FS/FS/part_fee.pm
new file mode 100644 (file)
index 0000000..67da245
--- /dev/null
@@ -0,0 +1,428 @@
+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;
+