[freeside-commits] branch master updated. 92b6628c08e4478e48b6f250320a3e3e93262ec2
Mark Wells
mark at 420.am
Tue Mar 31 11:54:07 PDT 2015
The branch, master has been updated
via 92b6628c08e4478e48b6f250320a3e3e93262ec2 (commit)
from 9f41e88b26563aa42785f0332338f9ff25511df8 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 92b6628c08e4478e48b6f250320a3e3e93262ec2
Author: Mark Wells <mark at freeside.biz>
Date: Tue Mar 31 11:53:29 2015 -0700
more flexible package suspend/unsuspend fees, #26828
diff --git a/FS/FS/FeeOrigin_Mixin.pm b/FS/FS/FeeOrigin_Mixin.pm
new file mode 100644
index 0000000..4eaf9b8
--- /dev/null
+++ b/FS/FS/FeeOrigin_Mixin.pm
@@ -0,0 +1,135 @@
+package FS::FeeOrigin_Mixin;
+
+use strict;
+use base qw( FS::Record );
+use FS::Record qw( qsearch qsearchs );
+use FS::part_fee;
+use FS::cust_bill_pkg;
+
+# is there a nicer idiom for this?
+our @subclasses = qw( FS::cust_event_fee FS::cust_pkg_reason_fee );
+use FS::cust_event_fee;
+use FS::cust_pkg_reason_fee;
+
+=head1 NAME
+
+FS::FeeOrigin_Mixin - Common interface for fee origin records
+
+=head1 SYNOPSIS
+
+ use FS::cust_event_fee;
+
+ $record = new FS::cust_event_fee \%hash;
+ $record = new FS::cust_event_fee { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::FeeOrigin_Mixin object associates the timestamped event that triggered
+a fee (which may be a billing event, or something else like a package
+suspension) to the resulting invoice line item (L<FS::cust_bill_pkg> object).
+The following fields are required:
+
+=over 4
+
+=item billpkgnum - key of the cust_bill_pkg record representing the fee
+on an invoice. This is a unique column but can be NULL to indicate a fee that
+hasn't been billed yet. In that case it will be billed the next time billing
+runs for the customer.
+
+=item feepart - key of the fee definition (L<FS::part_fee>).
+
+=item nextbill - 'Y' if the fee should be charged on the customer's next bill,
+rather than causing a bill to be produced immediately.
+
+=back
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item by_cust CUSTNUM[, PARAMS]
+
+Finds all cust_event_fee records belonging to the customer CUSTNUM.
+
+PARAMS can be additional params to pass to qsearch; this really only works
+for 'hashref' and 'order_by'.
+
+=cut
+
+# invoke for all subclasses, and return the results as a flat list
+
+sub by_cust {
+ my $class = shift;
+ my @args = @_;
+ return map { $_->_by_cust(@args) } @subclasses;
+}
+
+=back
+
+=head1 INTERFACE
+
+=over 4
+
+=item _by_cust CUSTNUM[, PARAMS]
+
+The L</by_cust> search method. Each subclass must implement this.
+
+=item cust_bill
+
+If the fee origin generates a fee based on past invoices (for example, an
+invoice event that charges late fees), this method should return the
+L<FS::cust_bill> object that will be the basis for the fee. If this returns
+nothing, then then fee will be based on the rest of the invoice where it
+appears.
+
+=item cust_pkg
+
+If the fee origin generates a fee limited in scope to one package (for
+example, a package reconnection fee event), this method should return the
+L<FS::cust_pkg> object the fee applies to. If it's a percentage fee, this
+determines which charges it's a percentage of; otherwise it just affects the
+fee description appearing on the invoice.
+
+Currently not tested in combination with L</cust_bill>; be careful.
+
+=cut
+
+# stubs
+
+sub _by_cust { my $class = shift; die "'$class' must provide _by_cust method" }
+
+sub cust_bill { '' }
+
+sub cust_pkg { '' }
+
+# stubs; remove in 4.x
+
+sub part_fee {
+ my $self = shift;
+ FS::part_fee->by_key($self->feepart);
+}
+
+sub cust_bill_pkg {
+ my $self = shift;
+ $self->billpkgnum ? FS::cust_bill_pkg->by_key($self->billpkgnum) : '';
+}
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::cust_event_fee>, L<FS::cust_pkg_reason_fee>, L<FS::cust_bill_pkg>,
+L<FS::part_fee>
+
+=cut
+
+1;
+
diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm
index 2cabf85..8f7f739 100644
--- a/FS/FS/Mason.pm
+++ b/FS/FS/Mason.pm
@@ -400,6 +400,7 @@ if ( -e $addl_handler_use_file ) {
use FS::cust_contact;
use FS::legacy_cust_history;
use FS::quotation_pkg_tax;
+ use FS::cust_pkg_reason_fee;
# Sammath Naur
if ( $FS::Mason::addl_handler_use ) {
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index a048d3e..fc56d90 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -2851,6 +2851,29 @@ sub tables_hashref {
],
},
+ 'cust_pkg_reason_fee' => {
+ 'columns' => [
+ 'pkgreasonfeenum', 'serial', '', '', '', '',
+ 'pkgreasonnum', 'int', '', '', '', '',
+ 'billpkgnum', 'int', 'NULL', '', '', '',
+ 'feepart', 'int', '', '', '', '',
+ 'nextbill', 'char', 'NULL', 1, '', '',
+ ],
+ 'primary_key' => 'pkgreasonfeenum',
+ 'unique' => [ [ 'billpkgnum' ], [ 'pkgreasonnum' ] ], # one-to-one link
+ 'index' => [ [ 'feepart' ] ],
+ 'foreign_keys' => [
+ { columns => [ 'pkgreasonnum' ],
+ table => 'cust_pkg_reason',
+ references => [ 'num' ],
+ },
+ { columns => [ 'feepart' ],
+ table => 'part_fee',
+ },
+ # can't link billpkgnum, because of voids
+ ],
+ },
+
'cust_pkg_discount' => {
'columns' => [
'pkgdiscountnum', 'serial', '', '', '', '',
@@ -5984,6 +6007,9 @@ sub tables_hashref {
'unsuspend_pkgpart', 'int', 'NULL', '', '', '',
'unsuspend_hold','char', 'NULL', 1, '', '',
'unused_credit', 'char', 'NULL', 1, '', '',
+ 'feepart', 'int', 'NULL', '', '', '',
+ 'fee_on_unsuspend','char', 'NULL', 1, '', '',
+ 'fee_hold', 'char', 'NULL', 1, '', '',
],
'primary_key' => 'reasonnum',
'unique' => [],
diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm
index 7257a9b..aa25f8c 100644
--- a/FS/FS/cust_bill_pkg.pm
+++ b/FS/FS/cust_bill_pkg.pm
@@ -295,13 +295,12 @@ sub insert {
} # foreach my $link
}
- my $cust_event_fee = $self->get('cust_event_fee');
- if ( $cust_event_fee ) {
- $cust_event_fee->set('billpkgnum' => $self->billpkgnum);
- $error = $cust_event_fee->replace;
+ if ( my $fee_origin = $self->get('fee_origin') ) {
+ $fee_origin->set('billpkgnum' => $self->billpkgnum);
+ $error = $fee_origin->replace;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "error updating cust_event_fee: $error";
+ return "error updating fee origin record: $error";
}
}
diff --git a/FS/FS/cust_event_fee.pm b/FS/FS/cust_event_fee.pm
index e88dcc4..375a533 100644
--- a/FS/FS/cust_event_fee.pm
+++ b/FS/FS/cust_event_fee.pm
@@ -1,7 +1,7 @@
package FS::cust_event_fee;
use strict;
-use base qw( FS::Record );
+use base qw( FS::Record FS::FeeOrigin_Mixin );
use FS::Record qw( qsearch qsearchs );
=head1 NAME
@@ -27,8 +27,8 @@ FS::cust_event_fee - Object methods for cust_event_fee records
An FS::cust_event_fee object links a billing event that charged a fee
(an L<FS::cust_event>) to the resulting invoice line item (an
-L<FS::cust_bill_pkg> object). FS::cust_event_fee inherits from FS::Record.
-The following fields are currently supported:
+L<FS::cust_bill_pkg> object). FS::cust_event_fee inherits from FS::Record
+and FS::FeeOrigin_Mixin. The following fields are currently supported:
=over 4
@@ -85,9 +85,6 @@ and replace methods.
=cut
-# the check method should currently be supplied - FS::Record contains some
-# data checking routines
-
sub check {
my $self = shift;
@@ -109,18 +106,14 @@ sub check {
=over 4
-=item by_cust CUSTNUM[, PARAMS]
-
-Finds all cust_event_fee records belonging to the customer CUSTNUM. Currently
-fee events can be cust_main, cust_pkg, or cust_bill events; this will return
-all of them.
+=item _by_cust CUSTNUM[, PARAMS]
-PARAMS can be additional params to pass to qsearch; this really only works
-for 'hashref' and 'order_by'.
+See L<FS::FeeOrigin_Mixin/by_cust>. This is the implementation for
+event-triggered fees.
=cut
-sub by_cust {
+sub _by_cust {
my $class = shift;
my $custnum = shift or return;
my %params = @_;
@@ -167,13 +160,45 @@ sub by_cust {
})
}
-
+=item cust_bill
+
+See L<FS::FeeOrigin_Mixin/cust_bill>. This version simply returns the event
+object if the event is an invoice event.
+
+=cut
+
+sub cust_bill {
+ my $self = shift;
+ my $object = $self->cust_event->cust_X;
+ if ( $object->isa('FS::cust_bill') ) {
+ return $object;
+ } else {
+ return '';
+ }
+}
+
+=item cust_pkg
+
+See L<FS::FeeOrigin_Mixin/cust_bill>. This version simply returns the event
+object if the event is a package event.
+
+=cut
+
+sub cust_pkg {
+ my $self = shift;
+ my $object = $self->cust_event->cust_X;
+ if ( $object->isa('FS::cust_pkg') ) {
+ return $object;
+ } else {
+ return '';
+ }
+}
=head1 BUGS
=head1 SEE ALSO
-L<FS::cust_event>, L<FS::part_fee>, L<FS::Record>
+L<FS::cust_event>, L<FS::FeeOrigin_Mixin>, L<FS::Record>
=cut
diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm
index 87499a9..9bfab96 100644
--- a/FS/FS/cust_main/Billing.pm
+++ b/FS/FS/cust_main/Billing.pm
@@ -21,7 +21,7 @@ use FS::cust_bill_pkg_tax_rate_location;
use FS::part_event;
use FS::part_event_condition;
use FS::pkg_category;
-use FS::cust_event_fee;
+use FS::FeeOrigin_Mixin;
use FS::Log;
use FS::TaxEngine;
@@ -601,17 +601,17 @@ sub bill {
# process fees
###
- my @pending_event_fees = FS::cust_event_fee->by_cust($self->custnum,
+ my @pending_fees = FS::FeeOrigin_Mixin->by_cust($self->custnum,
hashref => { 'billpkgnum' => '' }
);
- warn "$me found pending fee events:\n".Dumper(\@pending_event_fees)."\n"
- if @pending_event_fees and $DEBUG > 1;
+ warn "$me found pending fees:\n".Dumper(\@pending_fees)."\n"
+ if @pending_fees and $DEBUG > 1;
# determine whether to generate an invoice
my $generate_bill = scalar(@cust_bill_pkg) > 0;
- foreach my $event_fee (@pending_event_fees) {
- $generate_bill = 1 unless $event_fee->nextbill;
+ foreach my $fee (@pending_fees) {
+ $generate_bill = 1 unless $fee->nextbill;
}
# don't create an invoice with no line items, or where the only line
@@ -620,38 +620,11 @@ sub bill {
# calculate fees...
my @fee_items;
- foreach my $event_fee (@pending_event_fees) {
- my $object = $event_fee->cust_event->cust_X;
- my $part_fee = $event_fee->part_fee;
- my $cust_bill;
- if ( $object->isa('FS::cust_main')
- or $object->isa('FS::cust_pkg')
- or $object->isa('FS::cust_pay_batch') )
- {
- # Not the real cust_bill object that will be inserted--in particular
- # there are no taxes yet. If you want to charge a fee on the total
- # invoice amount including taxes, you have to put the fee on the next
- # invoice.
- $cust_bill = FS::cust_bill->new({
- 'custnum' => $self->custnum,
- 'cust_bill_pkg' => \@cust_bill_pkg,
- 'charged' => ${ $total_setup{$pass} } +
- ${ $total_recur{$pass} },
- });
-
- # If this is a package event, only apply the fee to line items
- # from that package.
- if ($object->isa('FS::cust_pkg')) {
- $cust_bill->set('cust_bill_pkg',
- [ grep { $_->pkgnum == $object->pkgnum } @cust_bill_pkg ]
- );
- }
+ foreach my $fee_origin (@pending_fees) {
+ my $part_fee = $fee_origin->part_fee;
- } elsif ( $object->isa('FS::cust_bill') ) {
- # simple case: applying the fee to a previous invoice (late fee,
- # etc.)
- $cust_bill = $object;
- }
+ # check whether the fee is applicable before doing anything expensive:
+ #
# if the fee def belongs to a different agent, don't charge the fee.
# event conditions should prevent this, but just in case they don't,
# skip the fee.
@@ -662,10 +635,41 @@ sub bill {
}
# also skip if it's disabled
next if $part_fee->disabled eq 'Y';
+
+ # Decide which invoice to base the fee on.
+ my $cust_bill = $fee_origin->cust_bill;
+ if (!$cust_bill) {
+ # Then link it to the current invoice. This isn't the real cust_bill
+ # object that will be inserted--in particular there are no taxes yet.
+ # If you want to charge a fee on the total invoice amount including
+ # taxes, you have to put the fee on the next invoice.
+ $cust_bill = FS::cust_bill->new({
+ 'custnum' => $self->custnum,
+ 'cust_bill_pkg' => \@cust_bill_pkg,
+ 'charged' => ${ $total_setup{$pass} } +
+ ${ $total_recur{$pass} },
+ });
+
+ # If the origin is for a specific package, then only apply the fee to
+ # line items from that package.
+ if ( my $cust_pkg = $fee_origin->cust_pkg ) {
+ my @charge_fee_on_item;
+ my $charge_fee_on_amount = 0;
+ foreach (@cust_bill_pkg) {
+ if ($_->pkgnum == $cust_pkg->pkgnum) {
+ push @charge_fee_on_item, $_;
+ $charge_fee_on_amount += $_->setup + $_->recur;
+ }
+ }
+ $cust_bill->set('cust_bill_pkg', \@charge_fee_on_item);
+ $cust_bill->set('charged', $charge_fee_on_amount);
+ }
+
+ } # $cust_bill is now set
# calculate the fee
my $fee_item = $part_fee->lineitem($cust_bill) or next;
# link this so that we can clear the marker on inserting the line item
- $fee_item->set('cust_event_fee', $event_fee);
+ $fee_item->set('fee_origin', $fee_origin);
push @fee_items, $fee_item;
}
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 0a1d002..4def528 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -1334,6 +1334,7 @@ sub suspend {
if $error;
}
+ my $cust_pkg_reason;
if ( $options{'reason'} ) {
$error = $self->insert_reason( 'reason' => $options{'reason'},
'action' => $date ? 'adjourn' : 'suspend',
@@ -1344,6 +1345,11 @@ sub suspend {
dbh->rollback if $oldAutoCommit;
return "Error inserting cust_pkg_reason: $error";
}
+ $cust_pkg_reason = qsearchs('cust_pkg_reason', {
+ 'date' => $date ? $date : $suspend_time,
+ 'action' => $date ? 'A' : 'S',
+ 'pkgnum' => $self->pkgnum,
+ });
}
# if a reasonnum was passed, get the actual reason object so we can check
@@ -1424,6 +1430,27 @@ sub suspend {
}
}
+ # suspension fees: if there is a feepart, and it's not an unsuspend fee,
+ # and this is not a suspend-before-cancel
+ if ( $cust_pkg_reason ) {
+ my $reason_obj = $cust_pkg_reason->reason;
+ if ( $reason_obj->feepart and
+ ! $reason_obj->fee_on_unsuspend and
+ ! $options{'from_cancel'} ) {
+
+ # register the need to charge a fee, cust_main->bill will do the rest
+ warn "registering suspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n"
+ if $DEBUG;
+ my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({
+ 'pkgreasonnum' => $cust_pkg_reason->num,
+ 'pkgnum' => $self->pkgnum,
+ 'feepart' => $reason->feepart,
+ 'nextbill' => $reason->fee_hold,
+ });
+ $error ||= $cust_pkg_reason_fee->insert;
+ }
+ }
+
my $conf = new FS::Conf;
if ( $conf->config('suspend_email_admin') && !$options{'from_cancel'} ) {
@@ -1721,23 +1748,39 @@ sub unsuspend {
my $unsusp_pkg;
- if ( $reason && $reason->unsuspend_pkgpart ) {
- my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
- or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
- " not found.";
- my $start_date = $self->cust_main->next_bill_date
- if $reason->unsuspend_hold;
-
- if ( $part_pkg ) {
- $unsusp_pkg = FS::cust_pkg->new({
- 'custnum' => $self->custnum,
- 'pkgpart' => $reason->unsuspend_pkgpart,
- 'start_date' => $start_date,
- 'locationnum' => $self->locationnum,
- # discount? probably not...
+ if ( $reason ) {
+ if ( $reason->unsuspend_pkgpart ) {
+ #warn "Suspend reason '".$reason->reason."' uses deprecated unsuspend_pkgpart feature.\n"; # in 4.x
+ my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
+ or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
+ " not found.";
+ my $start_date = $self->cust_main->next_bill_date
+ if $reason->unsuspend_hold;
+
+ if ( $part_pkg ) {
+ $unsusp_pkg = FS::cust_pkg->new({
+ 'custnum' => $self->custnum,
+ 'pkgpart' => $reason->unsuspend_pkgpart,
+ 'start_date' => $start_date,
+ 'locationnum' => $self->locationnum,
+ # discount? probably not...
+ });
+
+ $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
+ }
+ }
+ # new way, using fees
+ if ( $reason->feepart and $reason->fee_on_unsuspend ) {
+ # register the need to charge a fee, cust_main->bill will do the rest
+ warn "registering unsuspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n"
+ if $DEBUG;
+ my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({
+ 'pkgreasonnum' => $cust_pkg_reason->num,
+ 'pkgnum' => $self->pkgnum,
+ 'feepart' => $reason->feepart,
+ 'nextbill' => $reason->fee_hold,
});
-
- $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
+ $error ||= $cust_pkg_reason_fee->insert;
}
if ( $error ) {
diff --git a/FS/FS/cust_pkg_reason_fee.pm b/FS/FS/cust_pkg_reason_fee.pm
new file mode 100644
index 0000000..e5cc829
--- /dev/null
+++ b/FS/FS/cust_pkg_reason_fee.pm
@@ -0,0 +1,158 @@
+package FS::cust_pkg_reason_fee;
+
+use strict;
+use base qw( FS::Record FS::FeeOrigin_Mixin );
+use FS::Record qw( qsearch qsearchs );
+
+=head1 NAME
+
+FS::cust_pkg_reason_fee - Object methods for cust_pkg_reason_fee records
+
+=head1 SYNOPSIS
+
+ use FS::cust_pkg_reason_fee;
+
+ $record = new FS::cust_pkg_reason_fee \%hash;
+ $record = new FS::cust_pkg_reason_fee { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::cust_pkg_reason_fee object links a package status change that charged
+a fee (an L<FS::cust_pkg_reason> object) to the resulting invoice line item.
+FS::cust_pkg_reason_fee inherits from FS::Record and FS::FeeOrigin_Mixin.
+The following fields are currently supported:
+
+=over 4
+
+=item pkgreasonfeenum - primary key
+
+=item pkgreasonnum - key of the cust_pkg_reason object that triggered the fee.
+
+=item billpkgnum - key of the cust_bill_pkg record representing the fee on an
+invoice. This can be NULL if the fee is scheduled but hasn't been billed yet.
+
+=item feepart - key of the fee definition (L<FS::part_fee>).
+
+=item nextbill - 'Y' if the fee should be charged on the customer's next bill,
+rather than causing a bill to be produced immediately.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new record. To add the record to the database, see L<"insert">.
+
+=cut
+
+sub table { 'cust_pkg_reason_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('pkgreasonfeenum')
+ || $self->ut_foreign_key('pkgreasonnum', 'cust_pkg_reason', 'num')
+ || $self->ut_foreign_keyn('billpkgnum', 'cust_bill_pkg', 'billpkgnum')
+ || $self->ut_foreign_key('feepart', 'part_fee', 'feepart')
+ || $self->ut_flag('nextbill')
+ ;
+ return $error if $error;
+
+ $self->SUPER::check;
+}
+
+=back
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item _by_cust CUSTNUM[, PARAMS]
+
+See L<FS::FeeOrigin_Mixin/by_cust>.
+
+=cut
+
+sub _by_cust {
+ my $class = shift;
+ my $custnum = shift or return;
+ my %params = @_;
+ $custnum =~ /^\d+$/ or die "bad custnum $custnum";
+
+ my $where = ($params{hashref} && keys (%{ $params{hashref} }))
+ ? 'AND'
+ : 'WHERE';
+ qsearch({
+ table => 'cust_pkg_reason_fee',
+ addl_from => 'JOIN cust_pkg_reason ON (cust_pkg_reason_fee.pkgreasonnum = cust_pkg_reason.num) ' .
+ 'JOIN cust_pkg USING (pkgnum) ',
+ extra_sql => "$where cust_pkg.custnum = $custnum",
+ %params
+ });
+}
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item cust_pkg
+
+Returns the package that triggered the fee.
+
+=cut
+
+sub cust_pkg {
+ my $self = shift;
+ $self->cust_pkg_reason->cust_pkg;
+}
+
+#stub - remove in 4.x
+sub cust_pkg_reason {
+ my $self = shift;
+ FS::cust_pkg_reason->by_key($self->pkgreasonnum);
+}
+
+=head1 SEE ALSO
+
+L<FS::FeeOrigin_Mixin>, L<FS::cust_pkg_reason>, L<part_fee>
+
+=cut
+
+1;
+
diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm
index 9c34dd9..6f4bf62 100644
--- a/FS/FS/reason.pm
+++ b/FS/FS/reason.pm
@@ -50,7 +50,7 @@ FS::Record. The following fields are currently supported:
L<FS::part_pkg>) of a package to be ordered when the package is unsuspended.
Typically this will be some kind of reactivation fee. Attaching it to
a suspension reason allows the reactivation fee to be charged for some
-suspensions but not others.
+suspensions but not others. DEPRECATED.
=item unsuspend_hold - 'Y' or ''. If unsuspend_pkgpart is set, this tells
whether to bill the unsuspend package immediately ('') or to wait until
@@ -60,6 +60,15 @@ the customer's next invoice ('Y').
If enabled, the customer will be credited for their remaining time on
suspension.
+=item feepart - for suspension reasons, the feepart of a fee to be
+charged when a package is suspended for this reason.
+
+=item fee_hold - 'Y' or ''. If feepart is set, tells whether to bill the fee
+immediately ('') or wait until the customer's next invoice ('Y').
+
+=item fee_on_unsuspend - If feepart is set, tells whether to charge the fee
+on suspension ('') or unsuspension ('Y').
+
=back
=head1 METHODS
@@ -121,10 +130,14 @@ sub check {
|| $self->ut_foreign_keyn('unsuspend_pkgpart', 'part_pkg', 'pkgpart')
|| $self->ut_flag('unsuspend_hold')
|| $self->ut_flag('unused_credit')
+ || $self->ut_foreign_keyn('feepart', 'part_fee', 'feepart')
+ || $self->ut_flag('fee_on_unsuspend')
+ || $self->ut_flag('fee_hold')
;
return $error if $error;
} else {
- foreach (qw(unsuspend_pkgpart unsuspend_hold unused_credit)) {
+ foreach (qw(unsuspend_pkgpart unsuspend_hold unused_credit feepart
+ fee_on_unsuspend fee_hold)) {
$self->set($_ => '');
}
}
@@ -192,7 +205,6 @@ sub new_or_existing {
$reason;
}
-
=head1 BUGS
=head1 SEE ALSO
diff --git a/FS/MANIFEST b/FS/MANIFEST
index ca532ee..575184c 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -842,3 +842,6 @@ FS/quotation_pkg_tax.pm
t/quotation_pkg_tax.t
FS/h_svc_circuit.pm
FS/h_svc_circuit.t
+FS/FeeOrigin_Mixin.pm
+FS/cust_pkg_reason_fee.pm
+t/cust_pkg_reason_fee.t
diff --git a/FS/t/cust_pkg_reason_fee.t b/FS/t/cust_pkg_reason_fee.t
new file mode 100644
index 0000000..96cb79a
--- /dev/null
+++ b/FS/t/cust_pkg_reason_fee.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_pkg_reason_fee;
+$loaded=1;
+print "ok 1\n";
diff --git a/httemplate/browse/reason.html b/httemplate/browse/reason.html
index 5bb6a3e..8af88a9 100644
--- a/httemplate/browse/reason.html
+++ b/httemplate/browse/reason.html
@@ -65,7 +65,7 @@ my $align = 'rll';
if ( $class eq 'S' ) {
push @header,
'Credit unused service',
- 'Unsuspension fee',
+ 'Suspension fee',
;
push @fields,
sub {
@@ -78,17 +78,29 @@ if ( $class eq 'S' ) {
},
sub {
my $reason = shift;
- my $pkgpart = $reason->unsuspend_pkgpart or return '';
- my $part_pkg = FS::part_pkg->by_key($pkgpart) or return '';
- my $text = $part_pkg->pkg_comment;
- my $href = $p."edit/part_pkg.cgi?$pkgpart";
- $text = qq!<A HREF="$href">! . encode_entities($text) . "</A>".
- "<FONT SIZE=-1>";
- if ( $reason->unsuspend_hold ) {
- $text .= ' (on next bill)'
+ my $feepart = $reason->feepart;
+ my ($href, $text, $detail);
+ if ( $feepart ) {
+ my $part_fee = FS::part_fee->by_key($feepart) or return '';
+ $text = $part_fee->itemdesc . ': ' . $part_fee->explanation;
+ $detail = $reason->fee_on_unsuspend ? 'unsuspension' : 'suspension';
+ if ( $reason->fee_hold ) {
+ $detail = "next bill after $detail";
+ }
+ $detail = "(on $detail)";
+ $href = $p."edit/part_fee.html?$feepart";
} else {
- $text .= ' (immediately)'
+ my $pkgpart = $reason->unsuspend_pkgpart;
+ my $part_pkg = FS::part_pkg->by_key($pkgpart) or return '';
+ $text = $part_pkg->pkg_comment;
+ $href = $p."edit/part_pkg.cgi?$pkgpart";
+ $detail = $reason->unsuspend_hold ?
+ '(on next bill after unsuspension)' : '(on unsuspension)';
}
+ return '' unless length($text);
+
+ $text = qq!<A HREF="$href">! . encode_entities($text) . "</A> ".
+ "<FONT SIZE=-1>$detail</FONT>";
$text .= '</FONT>';
}
;
diff --git a/httemplate/edit/reason.html b/httemplate/edit/reason.html
index 3e6645e..30168d5 100644
--- a/httemplate/edit/reason.html
+++ b/httemplate/edit/reason.html
@@ -13,9 +13,12 @@
'reason' => $classname . ' Reason',
'disabled' => 'Disabled',
'class' => '',
- 'unsuspend_pkgpart' => 'Unsuspension fee',
- 'unsuspend_hold' => 'Delay until next bill',
+ 'feepart' => 'Charge a suspension fee',
+ 'fee_on_unsuspend' => 'When a package is',
+ 'fee_hold' => 'Delay fee until next bill',
'unused_credit' => 'Credit unused portion of service',
+ 'unsuspend_pkgpart' => 'Order an unsuspension package',
+ 'unsuspend_hold' => 'Delay package until next bill',
},
'fields' => \@fields,
&>
@@ -64,6 +67,28 @@ my @fields = (
if ( $class eq 'S' ) {
push @fields,
+ { 'field' => 'unused_credit',
+ 'type' => 'checkbox',
+ 'value' => 'Y',
+ },
+ { 'type' => 'tablebreak-tr-title' },
+ { 'field' => 'feepart',
+ 'type' => 'select-table',
+ 'table' => 'part_fee',
+ 'hashref' => { disabled => '' },
+ 'name_col' => 'itemdesc',
+ 'value_col' => 'feepart',
+ 'empty_label' => 'none',
+ },
+ { 'field' => 'fee_on_unsuspend',
+ 'type' => 'select',
+ 'options' => [ '', 'Y' ],
+ 'labels' => { '' => 'suspended', 'Y' => 'unsuspended' },
+ },
+ { 'field' => 'fee_hold',
+ 'type' => 'checkbox',
+ 'value' => 'Y',
+ },
{ 'field' => 'unsuspend_pkgpart',
'type' => 'select-part_pkg',
'hashref' => { 'disabled' => '',
@@ -73,10 +98,6 @@ if ( $class eq 'S' ) {
'type' => 'checkbox',
'value' => 'Y',
},
- { 'field' => 'unused_credit',
- 'type' => 'checkbox',
- 'value' => 'Y',
- },
;
}
diff --git a/httemplate/elements/tr-select-reason.html b/httemplate/elements/tr-select-reason.html
index 3565975..1258746 100755
--- a/httemplate/elements/tr-select-reason.html
+++ b/httemplate/elements/tr-select-reason.html
@@ -35,13 +35,17 @@ Example:
% # - no redundant checking of ACLs or parameters
% # - form fields are grouped for easy management
% # - use the standard select-table widget instead of ad hoc crap
+<& /elements/xmlhttp.html,
+ url => $p . 'misc/xmlhttp-reason-hint.html',
+ subs => [ 'get_hint' ],
+&>
<SCRIPT TYPE="text/javascript">
function <% $id %>_changed() {
- var hints = <% encode_json(\%all_hints) %>;
var select_reason = document.getElementById('<% $id %>');
- document.getElementById('<% $id %>_hint').innerHTML =
- hints[select_reason.value] || '';
+ get_hint(select_reason.value, function(stuff) {
+ document.getElementById('<% $id %>_hint').innerHTML = stuff || '';
+ });
// toggle submit button state
var submit_button = document.getElementById(<% $opt{control_button} |js_string %>);
@@ -123,24 +127,45 @@ Example:
field => $id.'_new_unused_credit',
value => 'Y'
&>
- <& tr-select-part_pkg.html,
- label => 'Charge this fee when unsuspending',
- field => $id.'_new_unsuspend_pkgpart',
- hashref => { disabled => '', freq => '0' },
+ <& tr-select-table.html,
+ label => 'Charge a suspension fee',
+ field => $id.'_new_feepart',
+ table => 'part_fee',
+ hashref => { disabled => '' },
+ name_col => 'itemdesc',
+ value_col => 'feepart',
empty_label => 'none',
&>
+ <& tr-select.html,
+ label => 'When this package is',
+ field => $id.'_new_fee_on_unsuspend',
+ options => [ '', 'Y' ],
+ labels => { '' => 'suspended', 'Y' => 'unsuspended' },
+ &>
<& tr-checkbox.html,
- label => 'Hold unsuspension fee until the next bill',
- field => $id.'_new_unsuspend_hold',
- value => 'Y',
+ label => 'Delay fee until the next bill',
+ field => $id.'_new_fee_hold',
+ value => 'Y',
&>
+%# deprecated, but still accessible through the "Suspend Reasons" UI
+%# <& tr-select-part_pkg.html,
+%# label => 'Charge this fee when unsuspending',
+%# field => $id.'_new_unsuspend_pkgpart',
+%# hashref => { disabled => '', freq => '0' },
+%# empty_label => 'none',
+%# &>
+%# <& tr-checkbox.html,
+%# label => 'Hold unsuspension fee until the next bill',
+%# field => $id.'_new_unsuspend_hold',
+%# value => 'Y',
+%# &>
% }
</table>
</td>
</tr>
% } # if the current user can add a reason
-% # container for hints
+% # container for hints (hints themselves come from xmlhttp-reason-hint)
<TR>
<TD COLSPAN=2 ALIGN="center" id="<% $id %>_hint" style="font-size:small">
</TD>
@@ -188,43 +213,6 @@ my @reasons = qsearch({
'order_by' => ' ORDER BY type, reason',
});
-my %all_hints;
-if ( $class eq 'S' ) {
- my $conf = FS::Conf->new;
- %all_hints = ( 0 => '', -1 => '' );
- foreach my $reason (@reasons) {
- my @hints;
- if ( $reason->unsuspend_pkgpart ) {
- my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart);
- if ( $part_pkg ) {
- if ( $part_pkg->option('setup_fee',1) > 0 and
- $part_pkg->option('recur_fee',1) == 0 ) {
- # the usual case
- push @hints,
- mt('A [_1] unsuspension fee will apply.',
- ($conf->config('money_char') || '$') .
- sprintf('%.2f', $part_pkg->option('setup_fee'))
- );
- } else {
- # oddball cases--not really supported
- push @hints,
- mt('An unsuspension package will apply: [_1]',
- $part_pkg->price_info
- );
- }
- } else { #no $part_pkg
- push @hints,
- '<FONT COLOR="#ff0000">Unsuspend pkg #'.$reason->unsuspend_pkgpart.
- ' not found.</FONT>';
- }
- }
- if ( $reason->unused_credit ) {
- push @hints, mt('The customer will be credited for unused time.');
- }
- $all_hints{ $reason->reasonnum } = join('<BR>', @hints);
- }
-}
-
my @post_options;
if ( $curuser->access_right($add_access_right) ) {
@post_options = ( -1 => 'Add new reason' );
diff --git a/httemplate/misc/process/elements/reason b/httemplate/misc/process/elements/reason
index ae92a75..f57f11f 100644
--- a/httemplate/misc/process/elements/reason
+++ b/httemplate/misc/process/elements/reason
@@ -8,7 +8,8 @@ my $error;
if ($reasonnum == -1) {
my $new_reason = FS::reason->new({
map { $_ => scalar( $cgi->param("reasonnum_new_$_") ) }
- qw( reason_type reason unsuspend_pkgpart unsuspend_hold unused_credit )
+ qw( reason_type reason unsuspend_pkgpart unsuspend_hold unused_credit
+ feepart fee_on_unsuspend fee_hold )
}); # not sanitizing them here, but check() will do it
$error = $new_reason->insert;
$reasonnum = $new_reason->reasonnum;
diff --git a/httemplate/misc/xmlhttp-reason-hint.html b/httemplate/misc/xmlhttp-reason-hint.html
new file mode 100644
index 0000000..5d54788
--- /dev/null
+++ b/httemplate/misc/xmlhttp-reason-hint.html
@@ -0,0 +1,83 @@
+<%doc>
+Example:
+
+<& /elements/xmlhttp.html,
+ url => $p . 'misc/xmlhttp-reason-hint.html',
+ subs => [ 'get_hint' ]
+&>
+<script>
+var reasonnum = 101;
+get_hint( reasonnum, function(stuff) { alert(stuff); } )
+</script>
+
+Currently will provide hints for:
+1. suspension events (new-style reconnection fees, notification)
+2. unsuspend_pkgpart package info (older reconnection fees)
+3. crediting for unused time
+</%doc>
+<%init>
+my $sub = $cgi->param('sub');
+my ($reasonnum) = $cgi->param('arg');
+# arg is a reasonnum
+my $conf = FS::Conf->new;
+my $error = '';
+my @hints;
+if ( $reasonnum =~ /^\d+$/ ) {
+ my $reason = FS::reason->by_key($reasonnum);
+ if ( $reason ) {
+ # 1.
+ if ( $reason->feepart ) { # XXX
+ my $part_fee = FS::part_fee->by_key($reason->feepart);
+ my $when = '';
+ if ( $reason->fee_hold ) {
+ $when = 'on the next bill after ';
+ } else {
+ $when = 'upon ';
+ }
+ if ( $reason->fee_on_unsuspend ) {
+ $when .= 'unsuspension';
+ } else {
+ $when .= 'suspension';
+ }
+
+ my $fee_amt = $part_fee->explanation;
+ push @hints, mt('A fee of [_1] will be charged [_2].',
+ $fee_amt, $when);
+ }
+ # 2.
+ if ( $reason->unsuspend_pkgpart ) {
+ my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart);
+ if ( $part_pkg ) {
+ if ( $part_pkg->option('setup_fee',1) > 0 and
+ $part_pkg->option('recur_fee',1) == 0 ) {
+ # the usual case
+ push @hints,
+ mt('A [_1] unsuspension fee will apply.',
+ ($conf->config('money_char') || '$') .
+ sprintf('%.2f', $part_pkg->option('setup_fee'))
+ );
+ } else {
+ # oddball cases--not really supported
+ push @hints,
+ mt('An unsuspension package will apply: [_1]',
+ $part_pkg->price_info
+ );
+ }
+ } else { #no $part_pkg
+ push @hints,
+ '<FONT COLOR="#ff0000">Unsuspend pkg #'.$reason->unsuspend_pkgpart.
+ ' not found.</FONT>';
+ }
+ }
+ # 3.
+ if ( $reason->unused_credit ) {
+ push @hints, mt('The customer will be credited for unused time.');
+ }
+ } else {
+ warn "reasonnum $reasonnum not found; returning no hints\n";
+ }
+} else {
+ warn "reason-hint arg '$reasonnum' not a valid reasonnum\n";
+}
+</%init>
+<% join('<BR>', @hints) %>
-----------------------------------------------------------------------
Summary of changes:
FS/FS/FeeOrigin_Mixin.pm | 135 +++++++++++++++++
FS/FS/Mason.pm | 1 +
FS/FS/Schema.pm | 26 ++++
FS/FS/cust_bill_pkg.pm | 9 +-
FS/FS/cust_event_fee.pm | 57 +++++--
FS/FS/cust_main/Billing.pm | 80 +++++-----
FS/FS/cust_pkg.pm | 75 ++++++++--
FS/FS/cust_pkg_reason_fee.pm | 158 ++++++++++++++++++++
FS/FS/reason.pm | 18 ++-
FS/MANIFEST | 3 +
...art_pkg_usage_class.t => cust_pkg_reason_fee.t} | 2 +-
httemplate/browse/reason.html | 32 ++--
httemplate/edit/reason.html | 33 +++-
httemplate/elements/tr-select-reason.html | 84 +++++------
httemplate/misc/process/elements/reason | 3 +-
httemplate/misc/xmlhttp-reason-hint.html | 83 ++++++++++
16 files changed, 655 insertions(+), 144 deletions(-)
create mode 100644 FS/FS/FeeOrigin_Mixin.pm
create mode 100644 FS/FS/cust_pkg_reason_fee.pm
copy FS/t/{part_pkg_usage_class.t => cust_pkg_reason_fee.t} (99%)
create mode 100644 httemplate/misc/xmlhttp-reason-hint.html
More information about the freeside-commits
mailing list