summaryrefslogtreecommitdiff
path: root/FS
diff options
context:
space:
mode:
Diffstat (limited to 'FS')
-rw-r--r--FS/FS/ClientAPI/MyAccount.pm16
-rw-r--r--FS/FS/Conf.pm13
-rw-r--r--FS/FS/Mason.pm5
-rw-r--r--FS/FS/Schema.pm50
-rw-r--r--FS/FS/cdr.pm74
-rw-r--r--FS/FS/cdr_cust_pkg_usage.pm124
-rw-r--r--FS/FS/cust_pkg.pm194
-rw-r--r--FS/FS/cust_pkg_usage.pm163
-rw-r--r--FS/FS/part_pkg.pm13
-rw-r--r--FS/FS/part_pkg/voip_cdr.pm36
-rw-r--r--FS/FS/part_pkg_usage.pm159
-rw-r--r--FS/FS/part_pkg_usage_class.pm125
-rw-r--r--FS/MANIFEST10
-rw-r--r--FS/bin/freeside-cdrrated16
-rw-r--r--FS/t/cdr_cust_pkg_usage.t5
-rw-r--r--FS/t/cust_pkg_usage.t5
-rw-r--r--FS/t/part_pkg_usage.t5
-rw-r--r--FS/t/part_pkg_usage_class.t5
18 files changed, 985 insertions, 33 deletions
diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm
index 38139e11b..775131e5a 100644
--- a/FS/FS/ClientAPI/MyAccount.pm
+++ b/FS/FS/ClientAPI/MyAccount.pm
@@ -1643,15 +1643,26 @@ sub list_svcs {
}
my @cust_svc = ();
+ my @cust_pkg_usage = ();
#foreach my $cust_pkg ( $cust_main->ncancelled_pkgs ) {
foreach my $cust_pkg ( $p->{'ncancelled'}
? $cust_main->ncancelled_pkgs
: $cust_main->unsuspended_pkgs ) {
next if $pkgnum && $cust_pkg->pkgnum != $pkgnum;
push @cust_svc, @{[ $cust_pkg->cust_svc ]}; #@{[ ]} to force array context
+ push @cust_pkg_usage, $cust_pkg->cust_pkg_usage;
}
@cust_svc = grep { $_->part_svc->selfservice_access ne 'hidden' } @cust_svc;
+ my %usage_pools;
+ foreach (@cust_pkg_usage) {
+ my $part = $_->part_pkg_usage;
+ my $tag = $part->description . ($part->shared ? 1 : 0);
+ my $row = $usage_pools{$tag}
+ ||= [ $part->description, 0, 0, $part->shared ? 1 : 0 ];
+ $row->[1] += $_->minutes; # minutes remaining
+ $row->[2] += $part->minutes; # minutes total
+ }
if ( $p->{'svcdb'} ) {
my $svcdb = ref($p->{'svcdb'}) eq 'HASH'
@@ -1761,6 +1772,11 @@ sub list_svcs {
}
@cust_svc
],
+ 'usage_pools' => [
+ map { $usage_pools{$_} }
+ sort { $a cmp $b }
+ keys %usage_pools
+ ],
};
}
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index 4b56eae61..e8747f28a 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -5347,6 +5347,19 @@ and customer address. Include units.',
$cdr_type ? $cdr_type->cdrtypename : '';
},
},
+
+ {
+ 'key' => 'cdr-minutes_priority',
+ 'section' => 'telephony',
+ 'description' => 'Priority rule for assigning included minutes to CDRs.',
+ 'type' => 'select',
+ 'select_hash' => [
+ '' => 'No specific order',
+ 'time' => 'Chronological',
+ 'rate_high' => 'Highest rate first',
+ 'rate_low' => 'Lowest rate first',
+ ],
+ },
{
'key' => 'brand-agent',
diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm
index 2bc1596f2..ae75539ac 100644
--- a/FS/FS/Mason.pm
+++ b/FS/FS/Mason.pm
@@ -332,6 +332,11 @@ if ( -e $addl_handler_use_file ) {
use FS::GeocodeCache;
use FS::log;
use FS::log_context;
+ use FS::part_pkg_usage_class;
+ use FS::cust_pkg_usage;
+ use FS::part_pkg_usage_class;
+ use FS::part_pkg_usage;
+ use FS::cdr_cust_pkg_usage;
# Sammath Naur
if ( $FS::Mason::addl_handler_use ) {
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index eff4878fd..717e49844 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -1815,6 +1815,30 @@ sub tables_hashref {
'index' => [ [ 'pkgnum' ], [ 'discountnum' ], [ 'usernum' ], ],
},
+ 'cust_pkg_usage' => {
+ 'columns' => [
+ 'pkgusagenum', 'serial', '', '', '', '',
+ 'pkgnum', 'int', '', '', '', '',
+ 'minutes', 'int', '', '', '', '',
+ 'pkgusagepart', 'int', '', '', '', '',
+ ],
+ 'primary_key' => 'pkgusagenum',
+ 'unique' => [],
+ 'index' => [ [ 'pkgnum' ], [ 'pkgusagepart' ] ],
+ },
+
+ 'cdr_cust_pkg_usage' => {
+ 'columns' => [
+ 'cdrusagenum', 'bigserial', '', '', '', '',
+ 'acctid', 'bigint', '', '', '', '',
+ 'pkgusagenum', 'int', '', '', '', '',
+ 'minutes', 'int', '', '', '', '',
+ ],
+ 'primary_key' => 'cdrusagenum',
+ 'unique' => [],
+ 'index' => [ [ 'pkgusagenum' ], [ 'acctid' ] ],
+ },
+
'cust_bill_pkg_discount' => {
'columns' => [
'billpkgdiscountnum', 'serial', '', '', '', '',
@@ -3021,6 +3045,32 @@ sub tables_hashref {
'index' => [ [ 'disabled' ] ],
},
+ 'part_pkg_usage' => {
+ 'columns' => [
+ 'pkgusagepart', 'serial', '', '', '', '',
+ 'pkgpart', 'int', '', '', '', '',
+ 'minutes', 'int', '', '', '', '',
+ 'priority', 'int', 'NULL', '', '', '',
+ 'shared', 'char', 'NULL', 1, '', '',
+ 'rollover', 'char', 'NULL', 1, '', '',
+ 'description', 'varchar', 'NULL', $char_d, '', '',
+ ],
+ 'primary_key' => 'pkgusagepart',
+ 'unique' => [],
+ 'index' => [ [ 'pkgpart' ] ],
+ },
+
+ 'part_pkg_usage_class' => {
+ 'columns' => [
+ 'num', 'serial', '', '', '', '',
+ 'pkgusagepart', 'int', '', '', '', '',
+ 'classnum', 'int','NULL', '', '', '',
+ ],
+ 'primary_key' => 'num',
+ 'unique' => [ [ 'pkgusagepart', 'classnum' ] ],
+ 'index' => [],
+ },
+
'rate' => {
'columns' => [
'ratenum', 'serial', '', '', '', '',
diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm
index 5e986ab50..9a3114442 100644
--- a/FS/FS/cdr.pm
+++ b/FS/FS/cdr.pm
@@ -426,12 +426,25 @@ sub set_charged_party {
Sets the status to the provided string. If there is an error, returns the
error, otherwise returns false.
+If status is being changed from 'rated' to some other status, also removes
+any usage allocations to this CDR.
+
=cut
sub set_status {
my($self, $status) = @_;
+ my $old_status = $self->freesidestatus;
$self->freesidestatus($status);
- $self->replace;
+ my $error = $self->replace;
+ if ( $old_status eq 'rated' and $status ne 'done' ) {
+ # deallocate any usage
+ foreach (qsearch('cdr_cust_pkg_usage', {acctid => $self->acctid})) {
+ my $cust_pkg_usage = $_->cust_pkg_usage;
+ $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $_->minutes);
+ $error ||= $cust_pkg_usage->replace || $_->delete;
+ }
+ }
+ $error;
}
=item set_status_and_rated_price STATUS RATED_PRICE [ SVCNUM [ OPTION => VALUE ... ] ]
@@ -578,7 +591,7 @@ reference of the number of included minutes and will be decremented by the
rated minutes of this CDR.
region_group_included_minutes_hashref is required for prefix price plans which
-have included minues (otehrwise unused/ignored). It should be set to an empty
+have included minues (otherwise unused/ignored). It should be set to an empty
hashref at the start of a month's rating and then preserved across CDRs.
=cut
@@ -603,6 +616,7 @@ our %interval_cache = (); # for timed rates
sub rate_prefix {
my( $self, %opt ) = @_;
my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
+ my $cust_pkg = $opt{'cust_pkg'};
my $da_rewrote = 0;
# this will result in those CDRs being marked as done... is that
@@ -828,11 +842,6 @@ sub rate_prefix {
$seconds_left -= $charge_sec;
- my $included_min = $opt{'region_group_included_min_hashref'} || {};
-
- $included_min->{$regionnum}{$ratetimenum} = $rate_detail->min_included
- unless exists $included_min->{$regionnum}{$ratetimenum};
-
my $granularity = $rate_detail->sec_granularity;
my $minutes;
@@ -850,20 +859,40 @@ sub rate_prefix {
$seconds += $charge_sec;
+ if ( $rate_detail->min_included ) {
+ # the old, kind of deprecated way to do this
+ my $included_min = $opt{'region_group_included_min_hashref'} || {};
- my $region_group = ($part_pkg->option_cacheable('min_included') || 0) > 0;
+ # by default, set the included minutes for this region/time to
+ # what's in the rate_detail
+ $included_min->{$regionnum}{$ratetimenum} = $rate_detail->min_included
+ unless exists $included_min->{$regionnum}{$ratetimenum};
- ${$opt{region_group_included_min}} -= $minutes
- if $region_group && $rate_detail->region_group;
+ # the way that doesn't work
+ #my $region_group = ($part_pkg->option_cacheable('min_included') || 0) > 0;
+
+ #${$opt{region_group_included_min}} -= $minutes
+ # if $region_group && $rate_detail->region_group;
+
+ if ( $included_min->{$regionnum}{$ratetimenum} > $minutes ) {
+ $charge_sec = 0;
+ $included_min->{$regionnum}{$ratetimenum} -= $minutes;
+ } else {
+ $charge_sec -= ($included_min->{$regionnum}{$ratetimenum} * 60);
+ $included_min->{$regionnum}{$ratetimenum} = 0;
+ }
+ } else {
+ # the new way!
+ my $applied_min = $cust_pkg->apply_usage(
+ 'cdr' => $self,
+ 'rate_detail' => $rate_detail,
+ 'minutes' => $minutes
+ );
+ # for now, usage pools deal only in whole minutes
+ $charge_sec -= $applied_min * 60;
+ }
- $included_min->{$regionnum}{$ratetimenum} -= $minutes;
- if (
- $included_min->{$regionnum}{$ratetimenum} <= 0
- && ( ${$opt{region_group_included_min}} <= 0
- || ! $rate_detail->region_group
- )
- )
- {
+ if ( $charge_sec > 0 ) {
#NOW do connection charges here... right?
#my $conn_seconds = min($seconds_left, $rate_detail->conn_sec);
@@ -876,16 +905,9 @@ sub rate_prefix {
}
#should preserve (display?) this
- my $charge_min = 0 - $included_min->{$regionnum}{$ratetimenum} - ( $conn_seconds / 60 );
- $included_min->{$regionnum}{$ratetimenum} = 0;
+ my $charge_min = ( $charge_sec - $conn_seconds ) / 60;
$charge += ($rate_detail->min_charge * $charge_min) if $charge_min > 0; #still not rounded
- } elsif ( ${$opt{region_group_included_min}} > 0
- && $region_group
- && $rate_detail->region_group
- )
- {
- $included_min->{$regionnum}{$ratetimenum} = 0
}
# choose next rate_detail
diff --git a/FS/FS/cdr_cust_pkg_usage.pm b/FS/FS/cdr_cust_pkg_usage.pm
new file mode 100644
index 000000000..6ef7f2dea
--- /dev/null
+++ b/FS/FS/cdr_cust_pkg_usage.pm
@@ -0,0 +1,124 @@
+package FS::cdr_cust_pkg_usage;
+
+use strict;
+use base qw( FS::Record );
+use FS::Record qw( qsearch qsearchs );
+
+=head1 NAME
+
+FS::cdr_cust_pkg_usage - Object methods for cdr_cust_pkg_usage records
+
+=head1 SYNOPSIS
+
+ use FS::cdr_cust_pkg_usage;
+
+ $record = new FS::cdr_cust_pkg_usage \%hash;
+ $record = new FS::cdr_cust_pkg_usage { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::cdr_cust_pkg_usage object represents an allocation of included
+usage minutes to a call. FS::cdr_cust_pkg_usage inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item cdrusagenum - primary key
+
+=item acctid - foreign key to cdr.acctid
+
+=item pkgusagenum - foreign key to cust_pkg_usage.pkgusagenum
+
+=item minutes - the number of minutes allocated
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new example. To add the example to the database, see L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to. You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'cdr_cust_pkg_usage'; }
+
+=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('cdrusagenum')
+ || $self->ut_foreign_key('acctid', 'cdr', 'acctid')
+ || $self->ut_foreign_key('pkgusagenum', 'cust_pkg_usage', 'pkgusagenum')
+ || $self->ut_number('minutes')
+ ;
+ return $error if $error;
+
+ $self->SUPER::check;
+}
+
+=item cust_pkg_usage
+
+Returns the L<FS::cust_pkg_usage> object that this usage allocation came from.
+
+=item cdr
+
+Returns the L<FS::cdr> object that the usage was applied to.
+
+=cut
+
+sub cust_pkg_usage {
+ FS::cust_pkg_usage->by_key($_[0]->pkgusagenum);
+}
+
+sub cdr {
+ FS::cdr->by_key($_[0]->acctid);
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 9c3d16a79..55a55ee8d 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -6,7 +6,7 @@ use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin
use vars qw($disable_agentcheck $DEBUG $me);
use Carp qw(cluck);
use Scalar::Util qw( blessed );
-use List::Util qw(max);
+use List::Util qw(min max);
use Tie::IxHash;
use Time::Local qw( timelocal timelocal_nocheck );
use MIME::Entity;
@@ -21,6 +21,8 @@ use FS::cust_location;
use FS::pkg_svc;
use FS::cust_bill_pkg;
use FS::cust_pkg_detail;
+use FS::cust_pkg_usage;
+use FS::cdr_cust_pkg_usage;
use FS::cust_event;
use FS::h_cust_svc;
use FS::reg_code;
@@ -861,6 +863,14 @@ sub cancel {
}
}
+ foreach my $usage ( $self->cust_pkg_usage ) {
+ $error = $usage->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "deleting usage pools: $error";
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
return '' if $date; #no errors
@@ -1825,6 +1835,16 @@ sub change {
$dbh->rollback if $oldAutoCommit;
return "Error setting usage values: $error";
}
+ } else {
+ # if NOT changing pkgpart, transfer any usage pools over
+ foreach my $usage ($self->cust_pkg_usage) {
+ $usage->set('pkgnum', $cust_pkg->pkgnum);
+ $error = $usage->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error transferring usage pools: $error";
+ }
+ }
}
# Order any supplemental packages.
@@ -3269,7 +3289,175 @@ sub cust_pkg_discount_active {
grep { $_->status eq 'active' } $self->cust_pkg_discount;
}
-=back
+=item cust_pkg_usage
+
+Returns a list of all voice usage counters attached to this package.
+
+=cut
+
+sub cust_pkg_usage {
+ my $self = shift;
+ qsearch('cust_pkg_usage', { pkgnum => $self->pkgnum });
+}
+
+=item apply_usage OPTIONS
+
+Takes the following options:
+- cdr: a call detail record (L<FS::cdr>)
+- rate_detail: the rate determined for this call (L<FS::rate_detail>)
+- minutes: the maximum number of minutes to be charged
+
+Finds available usage minutes for a call of this class, and subtracts
+up to that many minutes from the usage pool. If the usage pool is empty,
+and the C<cdr-minutes_priority> global config option is set, minutes may
+be taken from other calls as well. Either way, an allocation record will
+be created (L<FS::cdr_cust_pkg_usage>) and this method will return the
+number of minutes of usage applied to the call.
+
+=cut
+
+sub apply_usage {
+ my ($self, %opt) = @_;
+ my $cdr = $opt{cdr};
+ my $rate_detail = $opt{rate_detail};
+ my $minutes = $opt{minutes};
+ my $classnum = $rate_detail->classnum;
+ my $pkgnum = $self->pkgnum;
+ my $custnum = $self->custnum;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+ my $order = FS::Conf->new->config('cdr-minutes_priority');
+
+ my @usage_recs = qsearch({
+ 'table' => 'cust_pkg_usage',
+ 'addl_from' => ' JOIN part_pkg_usage USING (pkgusagepart)'.
+ ' JOIN cust_pkg USING (pkgnum)'.
+ ' JOIN part_pkg_usage_class USING (pkgusagepart)',
+ 'select' => 'cust_pkg_usage.*',
+ 'extra_sql' => " WHERE ( cust_pkg.pkgnum = $pkgnum OR ".
+ " ( cust_pkg.custnum = $custnum AND ".
+ " part_pkg_usage.shared IS NOT NULL ) ) AND ".
+ " part_pkg_usage_class.classnum = $classnum AND ".
+ " cust_pkg_usage.minutes > 0",
+ 'order_by' => " ORDER BY priority ASC",
+ });
+
+ my $orig_minutes = $minutes;
+ my $error;
+ while (!$error and $minutes > 0 and @usage_recs) {
+ my $cust_pkg_usage = shift @usage_recs;
+ $cust_pkg_usage->select_for_update;
+ my $cdr_cust_pkg_usage = FS::cdr_cust_pkg_usage->new({
+ pkgusagenum => $cust_pkg_usage->pkgusagenum,
+ acctid => $cdr->acctid,
+ minutes => min($cust_pkg_usage->minutes, $minutes),
+ });
+ $cust_pkg_usage->set('minutes',
+ sprintf('%.0f', $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes)
+ );
+ $error = $cust_pkg_usage->replace || $cdr_cust_pkg_usage->insert;
+ $minutes -= $cdr_cust_pkg_usage->minutes;
+ }
+ if ( $order and $minutes > 0 and !$error ) {
+ # then try to steal minutes from another call
+ my %search = (
+ 'table' => 'cdr_cust_pkg_usage',
+ 'addl_from' => ' JOIN cust_pkg_usage USING (pkgusagenum)'.
+ ' JOIN part_pkg_usage USING (pkgusagepart)'.
+ ' JOIN cust_pkg USING (pkgnum)'.
+ ' JOIN part_pkg_usage_class USING (pkgusagepart)'.
+ ' JOIN cdr USING (acctid)',
+ 'select' => 'cdr_cust_pkg_usage.*',
+ 'extra_sql' => " WHERE cdr.freesidestatus = 'rated' AND ".
+ " ( cust_pkg.pkgnum = $pkgnum OR ".
+ " ( cust_pkg.custnum = $custnum AND ".
+ " part_pkg_usage.shared IS NOT NULL ) ) AND ".
+ " part_pkg_usage_class.classnum = $classnum",
+ 'order_by' => ' ORDER BY part_pkg_usage.priority ASC',
+ );
+ if ( $order eq 'time' ) {
+ # find CDRs that are using minutes, but have a later startdate
+ # than this call
+ my $startdate = $cdr->startdate;
+ if ($startdate !~ /^\d+$/) {
+ die "bad cdr startdate '$startdate'";
+ }
+ $search{'extra_sql'} .= " AND cdr.startdate > $startdate";
+ # minimize needless reshuffling
+ $search{'order_by'} .= ', cdr.startdate DESC';
+ } else {
+ # XXX may not work correctly with rate_time schedules. Could
+ # fix this by storing ratedetailnum in cdr_cust_pkg_usage, I
+ # think...
+ $search{'addl_from'} .=
+ ' JOIN rate_detail'.
+ ' ON (cdr.rated_ratedetailnum = rate_detail.ratedetailnum)';
+ if ( $order eq 'rate_high' ) {
+ $search{'extra_sql'} .= ' AND rate_detail.min_charge < '.
+ $rate_detail->min_charge;
+ $search{'order_by'} .= ', rate_detail.min_charge ASC';
+ } elsif ( $order eq 'rate_low' ) {
+ $search{'extra_sql'} .= ' AND rate_detail.min_charge > '.
+ $rate_detail->min_charge;
+ $search{'order_by'} .= ', rate_detail.min_charge DESC';
+ } else {
+ # this should really never happen
+ die "invalid cdr-minutes_priority value '$order'\n";
+ }
+ }
+ my @cdr_usage_recs = qsearch(\%search);
+ my %reproc_cdrs;
+ while (!$error and @cdr_usage_recs and $minutes > 0) {
+ my $cdr_cust_pkg_usage = shift @cdr_usage_recs;
+ my $cust_pkg_usage = $cdr_cust_pkg_usage->cust_pkg_usage;
+ my $old_cdr = $cdr_cust_pkg_usage->cdr;
+ $reproc_cdrs{$old_cdr->acctid} = $old_cdr;
+ $cdr_cust_pkg_usage->select_for_update;
+ $old_cdr->select_for_update;
+ $cust_pkg_usage->select_for_update;
+ # in case someone else stole the usage from this CDR
+ # while waiting for the lock...
+ next if $old_cdr->acctid != $cdr_cust_pkg_usage->acctid;
+ # steal the usage allocation and flag the old CDR for reprocessing
+ $cdr_cust_pkg_usage->set('acctid', $cdr->acctid);
+ # if the allocation is more minutes than we need, adjust it...
+ my $delta = $cdr_cust_pkg_usage->minutes - $minutes;
+ if ( $delta > 0 ) {
+ $cdr_cust_pkg_usage->set('minutes', $minutes);
+ $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $delta);
+ $error = $cust_pkg_usage->replace;
+ }
+ warn 'CDR '.$cdr->acctid . ' stealing allocation '.$cdr_cust_pkg_usage->cdrusagenum.' from CDR '.$old_cdr->acctid."\n";
+ $error ||= $cdr_cust_pkg_usage->replace;
+ # deduct the stolen minutes
+ $minutes -= $cdr_cust_pkg_usage->minutes;
+ }
+ # after all minute-stealing is done, reset the affected CDRs
+ foreach (values %reproc_cdrs) {
+ $error ||= $_->set_status('');
+ # XXX or should we just call $cdr->rate right here?
+ # it's not like we can create a loop this way, since the min_charge
+ # or call time has to go monotonically in one direction.
+ # we COULD get some very deep recursions going, though...
+ }
+ } # if $order and $minutes
+ if ( $error ) {
+ $dbh->rollback;
+ die "error applying included minutes\npkgnum ".$self->pkgnum.", class $classnum, acctid ".$cdr->acctid."\n$error\n"
+ } else {
+ $dbh->commit if $oldAutoCommit;
+ return $orig_minutes - $minutes;
+ }
+}
=item supplemental_pkgs
@@ -3296,6 +3484,8 @@ sub main_pkg {
return;
}
+=back
+
=head1 CLASS METHODS
=over 4
diff --git a/FS/FS/cust_pkg_usage.pm b/FS/FS/cust_pkg_usage.pm
new file mode 100644
index 000000000..0eefd7480
--- /dev/null
+++ b/FS/FS/cust_pkg_usage.pm
@@ -0,0 +1,163 @@
+package FS::cust_pkg_usage;
+
+use strict;
+use base qw( FS::Record );
+use FS::cust_pkg;
+use FS::part_pkg_usage;
+use FS::Record qw( qsearch qsearchs );
+
+=head1 NAME
+
+FS::cust_pkg_usage - Object methods for cust_pkg_usage records
+
+=head1 SYNOPSIS
+
+ use FS::cust_pkg_usage;
+
+ $record = new FS::cust_pkg_usage \%hash;
+ $record = new FS::cust_pkg_usage { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::cust_pkg_usage object represents a counter of remaining included
+minutes on a voice-call package. FS::cust_pkg_usage inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item pkgusagenum - primary key
+
+=item pkgnum - the package (L<FS::cust_pkg>) containing the usage
+
+=item pkgusagepart - the usage stock definition (L<FS::part_pkg_usage>).
+This record in turn links to the call usage classes that are eligible to
+use these minutes.
+
+=item minutes - the remaining minutes
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+=cut
+
+sub table { 'cust_pkg_usage'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+sub delete {
+ my $self = shift;
+ my $error = $self->reset || $self->SUPER::delete;
+}
+
+=item reset
+
+Remove all allocations of this usage to CDRs.
+
+=cut
+
+sub reset {
+ my $self = shift;
+ my $error = '';
+ foreach (qsearch('cdr_cust_pkg_usage', { pkgusagenum => $self->pkgusagenum }))
+ {
+ $error ||= $_->delete;
+ }
+ $error;
+}
+
+=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.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=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
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('pkgusagenum')
+ || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum')
+ || $self->ut_numbern('minutes')
+ || $self->ut_foreign_key('pkgusagepart', 'part_pkg_usage', 'pkgusagepart')
+ ;
+ return $error if $error;
+
+ if ( $self->minutes eq '' ) {
+ $self->set(minutes => $self->part_pkg_usage->minutes);
+ }
+
+ $self->SUPER::check;
+}
+
+=item cust_pkg
+
+Return the L<FS::cust_pkg> linked to this record.
+
+=item part_pkg_usage
+
+Return the L<FS::part_pkg_usage> linked to this record.
+
+=cut
+
+sub cust_pkg {
+ my $self = shift;
+ FS::cust_pkg->by_key($self->pkgnum);
+}
+
+sub part_pkg_usage {
+ my $self = shift;
+ FS::part_pkg_usage->by_key($self->pkgusagepart);
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm
index 1b887a2f0..856a693dd 100644
--- a/FS/FS/part_pkg.pm
+++ b/FS/FS/part_pkg.pm
@@ -21,6 +21,7 @@ use FS::part_pkg_taxoverride;
use FS::part_pkg_taxproduct;
use FS::part_pkg_link;
use FS::part_pkg_discount;
+use FS::part_pkg_usage;
use FS::part_pkg_vendor;
@ISA = qw( FS::m2m_Common FS::option_Common );
@@ -1397,6 +1398,18 @@ sub part_pkg_discount {
qsearch('part_pkg_discount', { 'pkgpart' => $self->pkgpart });
}
+=item part_pkg_usage
+
+Returns the voice usage pools (see L<FS::part_pkg_usage>) defined for
+this package.
+
+=cut
+
+sub part_pkg_usage {
+ my $self = shift;
+ qsearch('part_pkg_usage', { 'pkgpart' => $self->pkgpart });
+}
+
=item _rebless
Reblesses the object into the FS::part_pkg::PLAN class (if available), where
diff --git a/FS/FS/part_pkg/voip_cdr.pm b/FS/FS/part_pkg/voip_cdr.pm
index 04098a897..67ddfb5e9 100644
--- a/FS/FS/part_pkg/voip_cdr.pm
+++ b/FS/FS/part_pkg/voip_cdr.pm
@@ -434,6 +434,7 @@ sub calc_usage {
my $error = $cdr->rate(
'part_pkg' => $self,
+ 'cust_pkg' => $cust_pkg,
'svcnum' => $svc_x->svcnum,
'single_price_included_min' => \$included_min,
'region_group_included_min' => \$region_group_included_min,
@@ -581,6 +582,41 @@ sub calc_units {
$count;
}
+sub reset_usage {
+ my ($self, $cust_pkg, %opt) = @_;
+ my @part_pkg_usage = $self->part_pkg_usage or return '';
+ warn " resetting usage minutes\n" if $opt{debug};
+ my %cust_pkg_usage = map { $_->pkgusagepart, $_ } $cust_pkg->cust_pkg_usage;
+ foreach my $part_pkg_usage (@part_pkg_usage) {
+ my $part = $part_pkg_usage->pkgusagepart;
+ my $usage = $cust_pkg_usage{$part} ||
+ FS::cust_pkg_usage->new({
+ 'pkgnum' => $cust_pkg->pkgnum,
+ 'pkgusagepart' => $part,
+ 'minutes' => $part_pkg_usage->minutes,
+ });
+ foreach my $cdr_usage (
+ qsearch('cdr_cust_pkg_usage', {'cdrusagenum' => $usage->cdrusagenum})
+ ) {
+ my $error = $cdr_usage->delete;
+ warn " error resetting CDR usage: $error\n";
+ }
+
+ if ( $usage->pkgusagenum ) {
+ if ( $part_pkg_usage->rollover ) {
+ $usage->set('minutes', $part_pkg_usage->minutes + $usage->minutes);
+ } else {
+ $usage->set('minutes', $part_pkg_usage->minutes);
+ }
+ my $error = $usage->replace;
+ warn " error resetting usage minutes: $error\n" if $error;
+ } else {
+ my $error = $usage->insert;
+ warn " error resetting usage minutes: $error\n" if $error;
+ }
+ } #foreach $part_pkg_usage
+}
+
# tells whether cust_bill_pkg_detail should return a single line for
# each phonenum
sub sum_usage {
diff --git a/FS/FS/part_pkg_usage.pm b/FS/FS/part_pkg_usage.pm
new file mode 100644
index 000000000..99014d398
--- /dev/null
+++ b/FS/FS/part_pkg_usage.pm
@@ -0,0 +1,159 @@
+package FS::part_pkg_usage;
+
+use strict;
+use base qw( FS::m2m_Common FS::Record );
+use FS::Record qw( qsearch qsearchs );
+use Scalar::Util qw(blessed);
+
+=head1 NAME
+
+FS::part_pkg_usage - Object methods for part_pkg_usage records
+
+=head1 SYNOPSIS
+
+ use FS::part_pkg_usage;
+
+ $record = new FS::part_pkg_usage \%hash;
+ $record = new FS::part_pkg_usage { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::part_pkg_usage object represents a stock of usage minutes (generally
+for voice services) included in a package definition. FS::part_pkg_usage
+inherits from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item pkgusagepart - primary key
+
+=item pkgpart - the package definition (L<FS::part_pkg>)
+
+=item minutes - the number of minutes included per billing cycle
+
+=item priority - the relative order in which to use this stock of minutes.
+
+=item shared - 'Y' to allow these minutes to be shared with other packages
+belonging to the same customer. Otherwise, only usage allocated to this
+package will use this stock of minutes.
+
+=item rollover - 'Y' to allow unused minutes to carry over between billing
+cycles. Otherwise, the available minutes will reset to the value of the
+"minutes" field upon billing.
+
+=item description - a text description of this stock of minutes
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+=item insert CLASSES
+
+=item replace CLASSES
+
+CLASSES can be an array or hash of usage classnums (see L<FS::usage_class>)
+to link to this record.
+
+=item delete
+
+=cut
+
+sub table { 'part_pkg_usage'; }
+
+sub insert {
+ my $self = shift;
+ my $opt = ref($_[0]) eq 'HASH' ? shift : { @_ };
+
+ $self->SUPER::insert
+ || $self->process_m2m( 'link_table' => 'part_pkg_usage_class',
+ 'target_table' => 'usage_class',
+ 'params' => $opt,
+ );
+}
+
+sub replace {
+ my $self = shift;
+ my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
+ ? shift
+ : $self->replace_old;
+ my $opt = ref($_[0]) eq 'HASH' ? $_[0] : { @_ };
+ $self->SUPER::replace($old)
+ || $self->process_m2m( 'link_table' => 'part_pkg_usage_class',
+ 'target_table' => 'usage_class',
+ 'params' => $opt,
+ );
+}
+
+sub delete {
+ my $self = shift;
+ $self->process_m2m( 'link_table' => 'part_pkg_usage_class',
+ 'target_table' => 'usage_class',
+ 'params' => {},
+ ) || $self->SUPER::delete;
+}
+
+=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('pkgusagepart')
+ || $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart')
+ || $self->ut_number('minutes')
+ || $self->ut_numbern('priority')
+ || $self->ut_flag('shared')
+ || $self->ut_flag('rollover')
+ || $self->ut_textn('description')
+ ;
+ return $error if $error;
+
+ $self->SUPER::check;
+}
+
+=item classnums
+
+Returns the usage class numbers that are allowed to use minutes from this
+pool.
+
+=cut
+
+sub classnums {
+ my $self = shift;
+ if (!$self->get('classnums')) {
+ my $classnums = [
+ map { $_->classnum }
+ qsearch('part_pkg_usage_class', { 'pkgusagepart' => $self->pkgusagepart })
+ ];
+ $self->set('classnums', $classnums);
+ }
+ @{ $self->get('classnums') };
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
diff --git a/FS/FS/part_pkg_usage_class.pm b/FS/FS/part_pkg_usage_class.pm
new file mode 100644
index 000000000..9a99783af
--- /dev/null
+++ b/FS/FS/part_pkg_usage_class.pm
@@ -0,0 +1,125 @@
+package FS::part_pkg_usage_class;
+
+use strict;
+use base qw( FS::Record );
+use FS::Record qw( qsearch qsearchs );
+
+=head1 NAME
+
+FS::part_pkg_usage_class - Object methods for part_pkg_usage_class records
+
+=head1 SYNOPSIS
+
+ use FS::part_pkg_usage_class;
+
+ $record = new FS::part_pkg_usage_class \%hash;
+ $record = new FS::part_pkg_usage_class { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::part_pkg_usage_class object is a link between a package usage stock
+(L<FS::part_pkg_usage>) and a voice usage class (L<FS::usage_class)>.
+FS::part_pkg_usage_class inherits from FS::Record. The following fields
+are currently supported:
+
+=over 4
+
+=item num - primary key
+
+=item pkgusagepart - L<FS::part_pkg_usage> key
+
+=item classnum - L<FS::usage_class> key. Set to null to allow this stock
+to be used for calls that have no usage class. To avoid confusion, you
+should only do this if you don't use usage classes on your system.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new example. To add the example to the database, see L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to. You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'part_pkg_usage_class'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=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.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid record. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('num')
+ || $self->ut_foreign_key('pkgusagepart', 'part_pkg_usage', 'pkgusagepart')
+ || $self->ut_foreign_keyn('classnum', 'usage_class', 'classnum')
+ ;
+ return $error if $error;
+
+ $self->SUPER::check;
+}
+
+=back
+
+=head1 BUGS
+
+The author forgot to customize this manpage.
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
diff --git a/FS/MANIFEST b/FS/MANIFEST
index 0214fe7bc..860f45fe2 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -677,3 +677,13 @@ FS/log.pm
t/log.t
FS/log_context.pm
t/log_context.t
+FS/part_pkg_usage_class.pm
+t/part_pkg_usage_class.t
+FS/cust_pkg_usage.pm
+t/cust_pkg_usage.t
+FS/part_pkg_usage_class.pm
+t/part_pkg_usage_class.t
+FS/part_pkg_usage.pm
+t/part_pkg_usage.t
+FS/cdr_cust_pkg_usage.pm
+t/cdr_cust_pkg_usage.t
diff --git a/FS/bin/freeside-cdrrated b/FS/bin/freeside-cdrrated
index 131b56a7e..99ea67594 100644
--- a/FS/bin/freeside-cdrrated
+++ b/FS/bin/freeside-cdrrated
@@ -33,9 +33,11 @@ if ( @cdrtypenums ) {
$extra_sql .= ' AND cdrtypenum IN ('. join(',', @cdrtypenums ). ')';
}
-our %svcnum = ();
-our %pkgpart = ();
-our %part_pkg = ();
+our %svcnum = (); # phonenum => svcnum
+our %pkgnum = (); # phonenum => pkgnum
+our %cust_pkg = (); # pkgnum => cust_pkg (NOT phonenum => cust_pkg!)
+our %pkgpart = (); # phonenum => pkgpart
+our %part_pkg = (); # phonenum => part_pkg
#some false laziness w/freeside-cdrrewrited
@@ -91,6 +93,9 @@ while (1) {
next;
}
+ $pkgnum{$number} = $cust_pkg->pkgnum;
+ $cust_pkg{$cust_pkg->pkgnum} ||= $cust_pkg;
+
#get the package, search through the part_pkg and linked for a voip_cdr def w/matching cdrtypenum (or no use_cdrtypenum)
my @part_pkg =
grep { $_->plan eq 'voip_cdr'
@@ -126,10 +131,11 @@ while (1) {
#}
#XXX if $part_pkg->option('min_included') then we can't prerate this CDR
-
+
my $error = $cdr->rate(
'part_pkg' => $part_pkg{ $pkgpart{$number} },
- 'svcnum' => $svcnum{ $number },
+ 'cust_pkg' => $cust_pkg{ $pkgnum{$number} },
+ 'svcnum' => $svcnum{$number},
);
if ( $error ) {
#XXX ???
diff --git a/FS/t/cdr_cust_pkg_usage.t b/FS/t/cdr_cust_pkg_usage.t
new file mode 100644
index 000000000..1e2060e96
--- /dev/null
+++ b/FS/t/cdr_cust_pkg_usage.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cdr_cust_pkg_usage;
+$loaded=1;
+print "ok 1\n";
diff --git a/FS/t/cust_pkg_usage.t b/FS/t/cust_pkg_usage.t
new file mode 100644
index 000000000..23a7b299e
--- /dev/null
+++ b/FS/t/cust_pkg_usage.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_pkg_usage;
+$loaded=1;
+print "ok 1\n";
diff --git a/FS/t/part_pkg_usage.t b/FS/t/part_pkg_usage.t
new file mode 100644
index 000000000..ba5ccb6c8
--- /dev/null
+++ b/FS/t/part_pkg_usage.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_pkg_usage;
+$loaded=1;
+print "ok 1\n";
diff --git a/FS/t/part_pkg_usage_class.t b/FS/t/part_pkg_usage_class.t
new file mode 100644
index 000000000..e46ff0648
--- /dev/null
+++ b/FS/t/part_pkg_usage_class.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_pkg_usage_class;
+$loaded=1;
+print "ok 1\n";
generated by cgit v1.2.1 (git 2.18.0) at 2024-09-24 15:33:04 +0000