+=item insert_reason
+
+Associates this package with a (suspension or cancellation) reason (see
+L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
+L<FS::reason>).
+
+Available options are:
+
+=over 4
+
+=item reason
+
+can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
+
+=item reason_otaker
+
+the access_user (see L<FS::access_user>) providing the reason
+
+=item date
+
+a unix timestamp
+
+=item action
+
+the action (cancel, susp, adjourn, expire) associated with the reason
+
+=back
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub insert_reason {
+ my ($self, %options) = @_;
+
+ my $otaker = $options{reason_otaker} ||
+ $FS::CurrentUser::CurrentUser->username;
+
+ my $reasonnum;
+ if ( $options{'reason'} =~ /^(\d+)$/ ) {
+
+ $reasonnum = $1;
+
+ } elsif ( ref($options{'reason'}) ) {
+
+ return 'Enter a new reason (or select an existing one)'
+ unless $options{'reason'}->{'reason'} !~ /^\s*$/;
+
+ my $reason = new FS::reason({
+ 'reason_type' => $options{'reason'}->{'typenum'},
+ 'reason' => $options{'reason'}->{'reason'},
+ });
+ my $error = $reason->insert;
+ return $error if $error;
+
+ $reasonnum = $reason->reasonnum;
+
+ } else {
+ return "Unparsable reason: ". $options{'reason'};
+ }
+
+ my $cust_pkg_reason =
+ new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
+ 'reasonnum' => $reasonnum,
+ 'otaker' => $otaker,
+ 'action' => substr(uc($options{'action'}),0,1),
+ 'date' => $options{'date'}
+ ? $options{'date'}
+ : time,
+ });
+
+ $cust_pkg_reason->insert;
+}
+
+=item insert_discount
+
+Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
+inserting a new discount on the fly (see L<FS::discount>).
+
+Available options are:
+
+=over 4
+
+=item discountnum
+
+=back
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub insert_discount {
+ #my ($self, %options) = @_;
+ my $self = shift;
+
+ my $cust_pkg_discount = new FS::cust_pkg_discount {
+ 'pkgnum' => $self->pkgnum,
+ 'discountnum' => $self->discountnum,
+ 'months_used' => 0,
+ 'end_date' => '', #XXX
+ #for the create a new discount case
+ '_type' => $self->discountnum__type,
+ 'amount' => $self->discountnum_amount,
+ 'percent' => $self->discountnum_percent,
+ 'months' => $self->discountnum_months,
+ 'setup' => $self->discountnum_setup,
+ #'disabled' => $self->discountnum_disabled,
+ };
+
+ $cust_pkg_discount->insert;
+}
+
+=item set_usage USAGE_VALUE_HASHREF
+
+USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
+to which they should be set (see L<FS::svc_acct>). Currently seconds,
+upbytes, downbytes, and totalbytes are appropriate keys.
+
+All svc_accts which are part of this package have their values reset.
+
+=cut
+
+sub set_usage {
+ my ($self, $valueref, %opt) = @_;
+
+ #only svc_acct can set_usage for now
+ foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
+ my $svc_x = $cust_svc->svc_x;
+ $svc_x->set_usage($valueref, %opt)
+ if $svc_x->can("set_usage");
+ }
+}
+
+=item recharge USAGE_VALUE_HASHREF
+
+USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
+to which they should be set (see L<FS::svc_acct>). Currently seconds,
+upbytes, downbytes, and totalbytes are appropriate keys.
+
+All svc_accts which are part of this package have their values incremented.
+
+=cut
+
+sub recharge {
+ my ($self, $valueref) = @_;
+
+ #only svc_acct can set_usage for now
+ foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
+ my $svc_x = $cust_svc->svc_x;
+ $svc_x->recharge($valueref)
+ if $svc_x->can("recharge");
+ }
+}
+
+=item cust_pkg_discount
+
+=cut
+
+sub cust_pkg_discount {
+ my $self = shift;
+ qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
+}
+
+=item cust_pkg_discount_active
+
+=cut
+
+sub cust_pkg_discount_active {
+ my $self = shift;
+ grep { $_->status eq 'active' } $self->cust_pkg_discount;
+}
+
+=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 $is_classnum;
+ if ( $classnum ) {
+ $is_classnum = ' part_pkg_usage_class.classnum = '.$classnum;
+ } else {
+ $is_classnum = ' part_pkg_usage_class.classnum IS NULL';
+ }
+ 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 ".
+ $is_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
+
+Returns a list of all packages supplemental to this one.
+
+=cut
+
+sub supplemental_pkgs {
+ my $self = shift;
+ qsearch('cust_pkg', { 'main_pkgnum' => $self->pkgnum });
+}
+
+=item main_pkg
+
+Returns the package that this one is supplemental to, if any.
+
+=cut
+
+sub main_pkg {
+ my $self = shift;
+ if ( $self->main_pkgnum ) {
+ return FS::cust_pkg->by_key($self->main_pkgnum);
+ }
+ return;
+}
+