package FS::cust_pkg;
+use base qw( FS::cust_pkg::Search FS::cust_pkg::API
+ FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin
+ FS::contact_Mixin FS::location_Mixin
+ FS::m2m_Common FS::option_Common
+ );
use strict;
-use base qw( FS::otaker_Mixin FS::cust_main_Mixin
- FS::contact_Mixin FS::location_Mixin
- FS::m2m_Common FS::option_Common );
-use vars qw($disable_agentcheck $DEBUG $me);
use Carp qw(cluck);
use Scalar::Util qw( blessed );
use List::Util qw(min max);
use Tie::IxHash;
use Time::Local qw( timelocal timelocal_nocheck );
use MIME::Entity;
-use FS::UID qw( getotaker dbh driver_name );
+use FS::UID qw( dbh driver_name );
use FS::Misc qw( send_email );
use FS::Record qw( qsearch qsearchs fields );
use FS::CurrentUser;
use FS::part_svc;
use FS::cust_pkg_reason;
use FS::reason;
+use FS::cust_pkg_usageprice;
use FS::cust_pkg_discount;
use FS::discount;
-use FS::UI::Web;
-use Data::Dumper;
+use FS::sales;
+# for modify_charge
+use FS::cust_credit;
# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
# setup }
# for sending cancel emails in sub cancel
use FS::Conf;
-$DEBUG = 0;
-$me = '[FS::cust_pkg]';
+our ($disable_agentcheck, $DEBUG, $me, $import) = (0, 0, '[FS::cust_pkg]', 0);
-$disable_agentcheck = 0;
+our $upgrade = 0; #go away after setup+start dates cleaned up for old customers
sub _cache {
my $self = shift;
$seconds = $record->seconds_since($timestamp);
+ #bulk cancel+order... perhaps slightly deprecated, only used by the bulk
+ # cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
$error = FS::cust_pkg::order( $custnum, \@pkgparts );
$error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
The package link (L<FS::part_pkg_link>) that defines this supplemental
package, if it is one.
+=item change_to_pkgnum
+
+The pkgnum of the package this one will be "changed to" in the future
+(on its expiration date).
+
=back
Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
' (cust_pkg.pkgnum '. $self->pkgnum. ')';
}
+=item set_initial_timers
+
+If required by the package definition, sets any automatic expire, adjourn,
+or contract_end timers to some number of months after the start date
+(or setup date, if the package has already been setup). If the package has
+a delayed setup fee after a period of "free days", will also set the
+start date to the end of that period.
+
+=cut
+
+sub set_initial_timers {
+ my $self = shift;
+ my $part_pkg = $self->part_pkg;
+ foreach my $action ( qw(expire adjourn contract_end) ) {
+ my $months = $part_pkg->option("${action}_months",1);
+ if($months and !$self->get($action)) {
+ my $start = $self->start_date || $self->setup || time;
+ $self->set($action, $part_pkg->add_freq($start, $months) );
+ }
+ }
+
+ # if this package has "free days" and delayed setup fee, then
+ # set start date that many days in the future.
+ # (this should have been set in the UI, but enforce it here)
+ if ( $part_pkg->option('free_days',1)
+ && $part_pkg->option('delay_setup',1)
+ )
+ {
+ $self->start_date( $part_pkg->default_start_date );
+ }
+ '';
+}
+
=item insert [ OPTION => VALUE ... ]
Adds this billing item to the database ("Orders" the item). If there is an
refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
record will be created corresponding to cust_main.refnum.
+If the additional field I<cust_pkg_usageprice> is defined, it will be treated
+as an arrayref of FS::cust_pkg_usageprice objects, which will be inserted.
+(Note that this field cannot be set with a usual ->cust_pkg_usageprice method.
+It can be set as part of the hash when creating the object, or with the B<set>
+method.)
+
The following options are available:
=over 4
=item change
-If set true, supresses any referral credit to a referring customer.
+If set true, supresses actions that should only be taken for new package
+orders. (Currently this includes: intro periods when delay_setup is on,
+auto-adding a 1st start date, auto-adding expiration/adjourn/contract_end dates)
=item options
my $part_pkg = $self->part_pkg;
- if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) {
- my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
- $mon += 1 unless $mday == 1;
- until ( $mon < 12 ) { $mon -= 12; $year++; }
- $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
- }
-
- foreach my $action ( qw(expire adjourn contract_end) ) {
- my $months = $part_pkg->option("${action}_months",1);
- if($months and !$self->$action) {
- my $start = $self->start_date || $self->setup || time;
- $self->$action( $part_pkg->add_freq($start, $months) );
- }
- }
+ if ( ! $import && ! $options{'change'} ) {
- my $free_days = $part_pkg->option('free_days',1);
- if ( $free_days && $part_pkg->option('delay_setup',1) ) { #&& !$self->start_date
- my ($mday,$mon,$year) = (localtime(time) )[3,4,5];
- #my $start_date = ($self->start_date || timelocal(0,0,0,$mday,$mon,$year)) + 86400 * $free_days;
- my $start_date = timelocal(0,0,0,$mday,$mon,$year) + 86400 * $free_days;
- $self->start_date($start_date);
- }
+ # set order date to now
+ $self->order_date(time) unless ($import && $self->order_date);
- $self->order_date(time);
+ # if the package def says to start only on the first of the month:
+ if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) {
+ my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
+ $mon += 1 unless $mday == 1;
+ until ( $mon < 12 ) { $mon -= 12; $year++; }
+ $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
+ }
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
+ if ($self->susp eq 'now' or $part_pkg->start_on_hold) {
+ # if the package was ordered on hold:
+ # - suspend it
+ # - don't set the start date (it will be started manually)
+ $self->set('susp', $self->order_date);
+ $self->set('start_date', '');
+ } else {
+ # set expire/adjourn/contract_end timers, and free days, if appropriate
+ $self->set_initial_timers;
+ }
+ } # else this is a package change, and shouldn't have "new package" behavior
my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
'params' => $self->refnum,
);
+ if ( $self->hashref->{cust_pkg_usageprice} ) {
+ for my $cust_pkg_usageprice ( @{ $self->hashref->{cust_pkg_usageprice} } ) {
+ $cust_pkg_usageprice->pkgnum( $self->pkgnum );
+ my $error = $cust_pkg_usageprice->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+
if ( $self->discountnum ) {
my $error = $self->insert_discount();
if ( $error ) {
}
}
- #if ( $self->reg_code ) {
- # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
- # $error = $reg_code->delete;
- # if ( $error ) {
- # $dbh->rollback if $oldAutoCommit;
- # return $error;
- # }
- #}
-
my $conf = new FS::Conf;
- if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
+ if ( ! $import && $conf->config('ticket_system') && $options{ticket_subject} ) {
#this init stuff is still inefficient, but at least its limited to
# the small number (any?) folks using ticket emailing on pkg order
);
}
- if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
+ if (! $import && $conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
my $queue = new FS::queue {
'job' => 'FS::cust_main::queueable_print',
};
sub delete {
my $self = shift;
- 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;
local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
- 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 $error = $new->SUPER::replace($old,
- $options->{options} ? $options->{options} : ()
- );
+ my $error = $new->export_pkg_change($old)
+ || $new->SUPER::replace( $old,
+ $options->{options}
+ ? $options->{options}
+ : ()
+ );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
|| $self->ut_numbern('pkgpart')
|| $self->ut_foreign_keyn('contactnum', 'contact', 'contactnum' )
|| $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
+ || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
+ || $self->ut_numbern('quantity')
|| $self->ut_numbern('start_date')
|| $self->ut_numbern('setup')
|| $self->ut_numbern('bill')
|| $self->ut_numbern('resume')
|| $self->ut_numbern('expire')
|| $self->ut_numbern('dundate')
- || $self->ut_enum('no_auto', [ '', 'Y' ])
- || $self->ut_enum('waive_setup', [ '', 'Y' ])
- || $self->ut_numbern('agent_pkgid')
+ || $self->ut_flag('no_auto', [ '', 'Y' ])
+ || $self->ut_flag('waive_setup', [ '', 'Y' ])
+ || $self->ut_flag('separate_bill')
+ || $self->ut_textn('agent_pkgid')
|| $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ])
|| $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ])
|| $self->ut_foreign_keyn('main_pkgnum', 'cust_pkg', 'pkgnum')
|| $self->ut_foreign_keyn('pkglinknum', 'part_pkg_link', 'pkglinknum')
+ || $self->ut_foreign_keyn('change_to_pkgnum', 'cust_pkg', 'pkgnum')
;
return $error if $error;
return "A package with both start date (future start) and setup date (already started) will never bill"
- if $self->start_date && $self->setup;
+ if $self->start_date && $self->setup && ! $upgrade;
return "A future unsuspend date can only be set for a package with a suspend date"
if $self->resume and !$self->susp and !$self->adjourn;
case. If it's not set, the 'unused_credit_cancel' part_pkg option will
be used.
+=item no_delay_cancel - prevents delay_cancel behavior
+no matter what other options say, for use when changing packages (or any
+other time you're really sure you want an immediate cancel)
+
=back
If there is an error, returns the error, otherwise returns false.
=cut
+#NOT DOCUMENTING - this should only be used when calling recursively
+#=item delay_cancel - for internal use, to allow proper handling of
+#supplemental packages when the main package is flagged to suspend
+#before cancelling, probably shouldn't be used otherwise (set the
+#corresponding package option instead)
+
sub cancel {
my( $self, %options ) = @_;
my $error;
# pass all suspend/cancel actions to the main package
- if ( $self->main_pkgnum and !$options{'from_main'} ) {
+ # (unless the pkglinknum has been removed, then the link is defunct and
+ # this package can be canceled on its own)
+ if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) {
return $self->main_pkg->cancel(%options);
}
join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
if $DEBUG;
- 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 $date = $options{'date'} if $options{'date'}; # expire/cancel later
$date = '' if ($date && $date <= $cancel_time); # complain instead?
+ my $delay_cancel = $options{'no_delay_cancel'} ? 0 : $options{'delay_cancel'};
+ if ( !$date && $self->part_pkg->option('delay_cancel',1)
+ && (($self->status eq 'active') || ($self->status eq 'suspended'))
+ && !$options{'no_delay_cancel'}
+ ) {
+ my $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
+ my $expsecs = 60*60*24*$expdays;
+ my $suspfor = $self->susp ? $cancel_time - $self->susp : 0;
+ $expsecs = $expsecs - $suspfor if $suspfor;
+ unless ($expsecs <= 0) { #if it's already been suspended long enough, don't re-suspend
+ $delay_cancel = 1;
+ $date = $cancel_time + $expsecs;
+ }
+ }
+
#race condition: usage could be ongoing until unprovisioned
#resolved by performing a change package instead (which unprovisions) and
#later cancelling
return $error;
}
}
-
} #unless $date
my %hash = $self->hash;
- $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
+ if ( $date ) {
+ $hash{'expire'} = $date;
+ if ($delay_cancel) {
+ # just to be sure these are clear
+ $hash{'adjourn'} = undef;
+ $hash{'resume'} = undef;
+ }
+ } else {
+ $hash{'cancel'} = $cancel_time;
+ }
$hash{'change_custnum'} = $options{'change_custnum'};
+
+ # if this is a supplemental package that's lost its part_pkg_link, and it's
+ # being canceled for real, unlink it completely
+ if ( !$date and ! $self->pkglinknum ) {
+ $hash{main_pkgnum} = '';
+ }
+
my $new = new FS::cust_pkg ( \%hash );
$error = $new->replace( $self, options => { $self->options } );
+ if ( $self->change_to_pkgnum ) {
+ my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
+ $error ||= $change_to->cancel('no_delay_cancel' => 1) || $change_to->delete;
+ }
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
foreach my $supp_pkg ( $self->supplemental_pkgs ) {
- $error = $supp_pkg->cancel(%options, 'from_main' => 1);
+ $error = $supp_pkg->cancel(%options,
+ 'from_main' => 1,
+ 'date' => $date, #in case it got changed by delay_cancel
+ 'delay_cancel' => $delay_cancel,
+ );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error";
}
}
- foreach my $usage ( $self->cust_pkg_usage ) {
- $error = $usage->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "deleting usage pools: $error";
+ if ($delay_cancel && !$options{'from_main'}) {
+ $error = $new->suspend(
+ 'from_cancel' => 1,
+ 'time' => $cancel_time
+ );
+ }
+
+ unless ($date) {
+ foreach my $usage ( $self->cust_pkg_usage ) {
+ $error = $usage->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "deleting usage pools: $error";
+ }
}
}
}
else {
$error = send_email(
- 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
+ 'from' => $conf->invoice_from_full( $self->cust_main->agentnum ),
'to' => \@invoicing_list,
'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
'body' => [ map "$_\n", $conf->config('cancelmessage') ],
+ 'custnum' => $self->custnum,
+ 'msgtype' => '', #admin?
);
}
#should this do something on errors?
# Transaction-alize
##
- 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;
setup
susp adjourn resume expire start_date contract_end dundate
change_date change_pkgpart change_locationnum
- manual_flag no_auto quantity agent_pkgid recur_show_zero setup_show_zero
+ manual_flag no_auto separate_bill quantity agent_pkgid
+ recur_show_zero setup_show_zero
),
};
my( $self, %options ) = @_;
my $error;
- 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;
=over 4
-=item reason - can be set to a cancellation reason (see L<FS:reason>),
+=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>
=item from_main - allows a supplemental package to be suspended, rather
than redirecting the method call to its main package. For internal use.
+=item from_cancel - used when suspending from the cancel method, forces
+this to skip everything besides basic suspension. For internal use.
+
=back
If there is an error, returns the error, otherwise returns false.
return $self->main_pkg->suspend(%options);
}
- 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;
}
# some false laziness with sub cancel
- if ( !$options{nobill} && !$date &&
+ if ( !$options{nobill} && !$date && !$options{'from_cancel'} &&
$self->part_pkg->option('bill_suspend_as_cancel',1) ) {
# kind of a kludge--'bill_suspend_as_cancel' to avoid having to
# make the entire cust_main->bill path recognize 'suspend' and
if $error;
}
+ my $cust_pkg_reason;
if ( $options{'reason'} ) {
$error = $self->insert_reason( 'reason' => $options{'reason'},
'action' => $date ? 'adjourn' : '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
+ # unused_credit
+ # (passing a reason hashref is still allowed, but it can't be used with
+ # the fancy behavioral options.)
+
+ my $reason;
+ if ($options{'reason'} =~ /^\d+$/) {
+ $reason = FS::reason->by_key($options{'reason'});
}
my %hash = $self->hash;
return $error;
}
- unless ( $date ) {
- # credit remaining time if appropriate
- if ( $self->part_pkg->option('unused_credit_suspend', 1) ) {
- my $error = $self->credit_remaining('suspend', $suspend_time);
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
+ unless ( $date ) { # then we are suspending now
+
+ unless ($options{'from_cancel'}) {
+ # credit remaining time if appropriate
+ # (if required by the package def, or the suspend reason)
+ my $unused_credit = $self->part_pkg->option('unused_credit_suspend',1)
+ || ( defined($reason) && $reason->unused_credit );
+
+ if ( $unused_credit ) {
+ warn "crediting unused time on pkg#".$self->pkgnum."\n" if $DEBUG;
+ my $error = $self->credit_remaining('suspend', $suspend_time);
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
}
}
- my @labels = ();
+ my @cust_svc = qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
+
+ #attempt ordering ala cust_svc_suspend_cascade (without infinite-looping
+ # on the circular dep case)
+ # (this is too simple for multi-level deps, we need to use something
+ # to resolve the DAG properly when possible)
+ my %svcpart = ();
+ $svcpart{$_->svcpart} = 0 foreach @cust_svc;
+ foreach my $svcpart ( keys %svcpart ) {
+ foreach my $part_svc_link (
+ FS::part_svc_link->by_agentnum($self->cust_main->agentnum,
+ src_svcpart => $svcpart,
+ link_type => 'cust_svc_suspend_cascade'
+ )
+ ) {
+ $svcpart{$part_svc_link->dst_svcpart} = max(
+ $svcpart{$part_svc_link->dst_svcpart},
+ $svcpart{$part_svc_link->src_svcpart} + 1
+ );
+ }
+ }
+ @cust_svc = sort { $svcpart{ $a->svcpart } <=> $svcpart{ $b->svcpart } }
+ @cust_svc;
- foreach my $cust_svc (
- qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
- ) {
- my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
+ my @labels = ();
+ foreach my $cust_svc ( @cust_svc ) {
+ $cust_svc->suspend( 'labels_arrayref' => \@labels );
+ }
- $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
- $dbh->rollback if $oldAutoCommit;
- return "Illegal svcdb value in part_svc!";
- };
- my $svcdb = $1;
- require "FS/$svcdb.pm";
+ # 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'} ) {
- my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
- if ($svc) {
- $error = $svc->suspend;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- my( $label, $value ) = $cust_svc->label;
- push @labels, "$label: $value";
+ # 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') ) {
+ if ( $conf->config('suspend_email_admin') && !$options{'from_cancel'} ) {
my $error = send_email(
'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
( map { "Service : $_\n" } @labels ),
],
+ 'custnum' => $self->custnum,
+ 'msgtype' => 'admin'
);
if ( $error ) {
=cut
+# Implementation note:
+#
+# If you pkgpart-change a package that has been billed, and it's set to give
+# credit on package change, then this method gets called and then the new
+# package will have no last_bill date. Therefore the customer will be credited
+# only once (per billing period) even if there are multiple package changes.
+#
+# If you location-change a package that has been billed, this method will NOT
+# be called and the new package WILL have the last bill date of the old
+# package.
+#
+# If the new package is then canceled within the same billing cycle,
+# credit_remaining needs to run calc_remain on the OLD package to determine
+# the amount of unused time to credit.
+
sub credit_remaining {
# Add a credit for remaining service
my ($self, $mode, $time) = @_;
and $next_bill > 0 # the package has a next bill date
and $next_bill >= $time # which is in the future
) {
- my $remaining_value = $self->calc_remain('time' => $time);
+ my @cust_credit_source_bill_pkg = ();
+ my $remaining_value = 0;
+
+ my $remain_pkg = $self;
+ $remaining_value = $remain_pkg->calc_remain(
+ 'time' => $time,
+ 'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
+ );
+
+ # we may have to walk back past some package changes to get to the
+ # one that actually has unused time
+ while ( $remaining_value == 0 ) {
+ if ( $remain_pkg->change_pkgnum ) {
+ $remain_pkg = FS::cust_pkg->by_key($remain_pkg->change_pkgnum);
+ } else {
+ # the package has really never been billed
+ return;
+ }
+ $remaining_value = $remain_pkg->calc_remain(
+ 'time' => $time,
+ 'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
+ );
+ }
+
if ( $remaining_value > 0 ) {
warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
if $DEBUG;
$remaining_value,
'Credit for unused time on '. $self->part_pkg->pkg,
'reason_type' => $reason_type,
+ 'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
);
return "Error crediting customer \$$remaining_value for unused time".
" on ". $self->part_pkg->pkg. ": $error"
Can be set true to adjust the next bill date forward by
the amount of time the account was inactive. This was set true by default
-since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
-explicitly requested. Price plans for which this makes sense (anniversary-date
-based than prorate or subscription) could have an option to enable this
-behaviour?
+in the past (from 1.4.2 and 1.5.0pre6 through 1.7.0), but now needs to be
+explicitly requested with this option or in the price plan.
=back
return $self->main_pkg->unsuspend(%opt);
}
- 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;
return ""; # no error # complain instead?
}
+ # handle the case of setting a future unsuspend (resume) date
+ # and do not continue to actually unsuspend the package
my $date = $opt{'date'};
if ( $date and $date > time ) { # return an error if $date <= time?
} #if $date
+ if (!$self->setup) {
+ # then this package is being released from on-hold status
+ $self->set_initial_timers;
+ }
+
my @labels = ();
foreach my $cust_svc (
my $conf = new FS::Conf;
- if ( $inactive > 0 &&
- ( $hash{'bill'} || $hash{'setup'} ) &&
- ( $opt{'adjust_next_bill'} ||
- $conf->exists('unsuspend-always_adjust_next_bill_date') ||
- $self->part_pkg->option('unsuspend_adjust_bill', 1) )
- ) {
+ #adjust the next bill date forward
+ # increment next bill date if certain conditions are met:
+ # - it was due to be billed at some point
+ # - either the global or local config says to do this
+ my $adjust_bill = 0;
+ if (
+ $inactive > 0
+ && ( $hash{'bill'} || $hash{'setup'} )
+ && ( $opt{'adjust_next_bill'}
+ || $conf->exists('unsuspend-always_adjust_next_bill_date')
+ || $self->part_pkg->option('unsuspend_adjust_bill', 1)
+ )
+ ) {
+ $adjust_bill = 1;
+ }
+
+ # but not if:
+ # - the package billed during suspension
+ # - or it was ordered on hold
+ # - or the customer was credited for the unused time
- $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
-
+ if ( $self->option('suspend_bill',1)
+ or ( $self->part_pkg->option('suspend_bill',1)
+ and ! $self->option('no_suspend_bill',1)
+ )
+ or $hash{'order_date'} == $hash{'susp'}
+ ) {
+ $adjust_bill = 0;
+ }
+
+ if ( $adjust_bill ) {
+ if ( $self->part_pkg->option('unused_credit_suspend')
+ or ( ref($reason) and $reason->unused_credit ) ) {
+ # then the customer was credited for the unused time before suspending,
+ # so their next bill should be immediate
+ $hash{'bill'} = time;
+ } else {
+ # add the length of time suspended to the bill date
+ $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
+ }
}
$hash{'susp'} = '';
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";
+ 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 ) {
: ''
),
],
+ 'custnum' => $self->custnum,
+ 'msgtype' => 'admin',
);
if ( $error ) {
my( $self, %options ) = @_;
my $error;
- 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;
New refnum (see L<FS::part_referral>).
+=item quantity
+
+New quantity; if unspecified, the new package will have the same quantity
+as the old.
+
+=item cust_pkg
+
+"New" (existing) FS::cust_pkg object. The package's services and other
+attributes will be transferred to this package.
+
=item keep_dates
Set to true to transfer billing dates (start_date, setup, last_bill, bill,
susp, adjourn, cancel, expire, and contract_end) to the new package.
+=item unprotect_svcs
+
+Normally, change() will rollback and return an error if some services
+can't be transferred (also see the I<cust_pkg-change_svcpart> config option).
+If unprotect_svcs is true, this method will transfer as many services as
+it can and then unconditionally cancel the old package.
+
=back
-At least one of locationnum, cust_location, pkgpart, refnum must be specified
-(otherwise, what's the point?)
+At least one of locationnum, cust_location, pkgpart, refnum, cust_main, or
+cust_pkg must be specified (otherwise, what's the point?)
Returns either the new FS::cust_pkg object or a scalar error.
my $self = shift;
my $opt = ref($_[0]) ? shift : { @_ };
-# my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
-#
-
my $conf = new FS::Conf;
# Transactionize this whole mess
- 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 $error;
+ if ( $opt->{'cust_location'} ) {
+ $error = $opt->{'cust_location'}->find_or_insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "creating location record: $error";
+ }
+ $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
+ }
+
+ # Before going any further here: if the package is still in the pre-setup
+ # state, it's safe to modify it in place. No need to charge/credit for
+ # partial period, transfer services, transfer usage pools, copy invoice
+ # details, or change any dates.
+ if ( ! $self->setup and ! $opt->{cust_pkg} and ! $opt->{cust_main} ) {
+ foreach ( qw( locationnum pkgpart quantity refnum salesnum ) ) {
+ if ( length($opt->{$_}) ) {
+ $self->set($_, $opt->{$_});
+ }
+ }
+ # almost. if the new pkgpart specifies start/adjourn/expire timers,
+ # apply those.
+ if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
+ $self->set_initial_timers;
+ }
+ $error = $self->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "modifying package: $error";
+ } else {
+ $dbh->commit if $oldAutoCommit;
+ return '';
+ }
+ }
+
my %hash = ();
my $time = time;
- #$hash{$_} = $self->$_() foreach qw( last_bill bill );
-
- #$hash{$_} = $self->$_() foreach qw( setup );
-
$hash{'setup'} = $time if $self->setup;
$hash{'change_date'} = $time;
$hash{"change_$_"} = $self->$_()
foreach qw( pkgnum pkgpart locationnum );
- if ( $opt->{'cust_location'} &&
- ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
-
- if ( ! $opt->{'cust_location'}->locationnum ) {
- # not inserted yet
- $error = $opt->{'cust_location'}->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "inserting cust_location (transaction rolled back): $error";
- }
- }
- $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
-
+ if ( $opt->{'cust_pkg'} ) {
+ # treat changing to a package with a different pkgpart as a
+ # pkgpart change (because it is)
+ $opt->{'pkgpart'} = $opt->{'cust_pkg'}->pkgpart;
}
# whether to override pkgpart checking on the new package
my $unused_credit = 0;
my $keep_dates = $opt->{'keep_dates'};
+
# Special case. If the pkgpart is changing, and the customer is
# going to be credited for remaining time, don't keep setup, bill,
# or last_bill dates, and DO pass the flag to cancel() to credit
}
if ( $keep_dates ) {
- foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire
- resume start_date contract_end ) ) {
+ foreach my $date ( qw(setup bill last_bill) ) {
$hash{$date} = $self->getfield($date);
}
}
+ # always keep the following dates
+ foreach my $date (qw(order_date susp adjourn cancel expire resume
+ start_date contract_end)) {
+ $hash{$date} = $self->getfield($date);
+ }
+
# allow $opt->{'locationnum'} = '' to specifically set it to null
# (i.e. customer default location)
$opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
# 2. (more importantly) changing a package before it's billed
$hash{'waive_setup'} = $self->waive_setup;
+ # if this package is scheduled for a future package change, preserve that
+ $hash{'change_to_pkgnum'} = $self->change_to_pkgnum;
+
my $custnum = $self->custnum;
if ( $opt->{cust_main} ) {
my $cust_main = $opt->{cust_main};
unless ( $cust_main->custnum ) {
- my $error = $cust_main->insert;
+ my $error = $cust_main->insert( @{ $opt->{cust_main_insert_args}||[] } );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "inserting cust_main (transaction rolled back): $error";
+ return "inserting customer record: $error";
}
}
$custnum = $cust_main->custnum;
$hash{'contactnum'} = $opt->{'contactnum'} if $opt->{'contactnum'};
- # Create the new package.
- my $cust_pkg = new FS::cust_pkg {
- custnum => $custnum,
- pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
- refnum => ( $opt->{'refnum'} || $self->refnum ),
- locationnum => ( $opt->{'locationnum'} ),
- %hash,
- };
- $error = $cust_pkg->insert( 'change' => 1,
- 'allow_pkgpart' => $same_pkgpart );
+ my $cust_pkg;
+ if ( $opt->{'cust_pkg'} ) {
+ # The target package already exists; update it to show that it was
+ # changed from this package.
+ $cust_pkg = $opt->{'cust_pkg'};
+
+ # follow all the above rules for date changes, etc.
+ foreach (keys %hash) {
+ $cust_pkg->set($_, $hash{$_});
+ }
+ # except those that implement the future package change behavior
+ foreach (qw(change_to_pkgnum start_date expire)) {
+ $cust_pkg->set($_, '');
+ }
+
+ $error = $cust_pkg->replace;
+
+ } else {
+ # Create the new package.
+ $cust_pkg = new FS::cust_pkg {
+ custnum => $custnum,
+ locationnum => $opt->{'locationnum'},
+ ( map { $_ => ( $opt->{$_} || $self->$_() ) }
+ qw( pkgpart quantity refnum salesnum )
+ ),
+ %hash,
+ };
+ $error = $cust_pkg->insert( 'change' => 1,
+ 'allow_pkgpart' => $same_pkgpart );
+ }
if ($error) {
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "inserting new package: $error";
}
# Transfer services and cancel old package.
-
+ # Enforce service limits only if this is a pkgpart change.
+ local $FS::cust_svc::ignore_quantity;
+ $FS::cust_svc::ignore_quantity = 1 if $same_pkgpart;
$error = $self->transfer($cust_pkg);
if ($error and $error == 0) {
# $old_pkg->transfer failed.
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "transferring $error";
}
if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
if ($error and $error == 0) {
# $old_pkg->transfer failed.
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "converting $error";
}
}
- if ($error > 0) {
+ # We set unprotect_svcs when executing a "future package change". It's
+ # not a user-interactive operation, so returning an error means the
+ # package change will just fail. Rather than have that happen, we'll
+ # let leftover services be deleted.
+ if ($error > 0 and !$opt->{'unprotect_svcs'}) {
# Transfers were successful, but we still had services left on the old
# package. We can't change the package under this circumstances, so abort.
$dbh->rollback if $oldAutoCommit;
- return "Unable to transfer all services from package ". $self->pkgnum;
+ return "unable to transfer all services";
}
#reset usage if changing pkgpart
if ($error) {
$dbh->rollback if $oldAutoCommit;
- return "Error setting usage values: $error";
+ return "setting usage values: $error";
}
} else {
# if NOT changing pkgpart, transfer any usage pools over
$error = $usage->replace;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "Error transferring usage pools: $error";
+ return "transferring usage pools: $error";
+ }
+ }
+ }
+
+ # transfer usage pricing add-ons, if we're not changing pkgpart
+ if ( $same_pkgpart ) {
+ foreach my $old_cust_pkg_usageprice ($self->cust_pkg_usageprice) {
+ my $new_cust_pkg_usageprice = new FS::cust_pkg_usageprice {
+ 'pkgnum' => $cust_pkg->pkgnum,
+ 'usagepricepart' => $old_cust_pkg_usageprice->usagepricepart,
+ 'quantity' => $old_cust_pkg_usageprice->quantity,
+ };
+ $error = $new_cust_pkg_usageprice->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error transferring usage pricing add-on: $error";
}
}
}
$error = $new_discount->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "Error transferring discounts: $error";
+ return "transferring discounts: $error";
}
}
}
- # Order any supplemental packages.
- my $part_pkg = $cust_pkg->part_pkg;
- my @old_supp_pkgs = $self->supplemental_pkgs;
- my @new_supp_pkgs;
- foreach my $link ($part_pkg->supp_part_pkg_link) {
- my $old;
- foreach (@old_supp_pkgs) {
- if ($_->pkgpart == $link->dst_pkgpart) {
- $old = $_;
- $_->pkgpart(0); # so that it can't match more than once
- }
- last if $old;
- }
- # false laziness with FS::cust_main::Packages::order_pkg
- my $new = FS::cust_pkg->new({
- pkgpart => $link->dst_pkgpart,
- pkglinknum => $link->pkglinknum,
- custnum => $custnum,
- main_pkgnum => $cust_pkg->pkgnum,
- locationnum => $cust_pkg->locationnum,
- start_date => $cust_pkg->start_date,
- order_date => $cust_pkg->order_date,
- expire => $cust_pkg->expire,
- adjourn => $cust_pkg->adjourn,
- contract_end => $cust_pkg->contract_end,
- refnum => $cust_pkg->refnum,
- discountnum => $cust_pkg->discountnum,
- waive_setup => $cust_pkg->waive_setup,
- });
- if ( $old and $opt->{'keep_dates'} ) {
- foreach (qw(setup bill last_bill)) {
- $new->set($_, $old->get($_));
- }
- }
- $error = $new->insert( allow_pkgpart => $same_pkgpart );
- # transfer services
- if ( $old ) {
- $error ||= $old->transfer($new);
- }
- if ( $error and $error > 0 ) {
- # no reason why this should ever fail, but still...
- $error = "Unable to transfer all services from supplemental package ".
- $old->pkgnum;
- }
+ # transfer (copy) invoice details
+ foreach my $detail ($self->cust_pkg_detail) {
+ my $new_detail = FS::cust_pkg_detail->new({ $detail->hash });
+ $new_detail->set('pkgdetailnum', '');
+ $new_detail->set('pkgnum', $cust_pkg->pkgnum);
+ $error = $new_detail->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "transferring package notes: $error";
}
- push @new_supp_pkgs, $new;
}
+
+ my @new_supp_pkgs;
+
+ if ( !$opt->{'cust_pkg'} ) {
+ # Order any supplemental packages.
+ my $part_pkg = $cust_pkg->part_pkg;
+ my @old_supp_pkgs = $self->supplemental_pkgs;
+ foreach my $link ($part_pkg->supp_part_pkg_link) {
+ my $old;
+ foreach (@old_supp_pkgs) {
+ if ($_->pkgpart == $link->dst_pkgpart) {
+ $old = $_;
+ $_->pkgpart(0); # so that it can't match more than once
+ }
+ last if $old;
+ }
+ # false laziness with FS::cust_main::Packages::order_pkg
+ my $new = FS::cust_pkg->new({
+ pkgpart => $link->dst_pkgpart,
+ pkglinknum => $link->pkglinknum,
+ custnum => $custnum,
+ main_pkgnum => $cust_pkg->pkgnum,
+ locationnum => $cust_pkg->locationnum,
+ start_date => $cust_pkg->start_date,
+ order_date => $cust_pkg->order_date,
+ expire => $cust_pkg->expire,
+ adjourn => $cust_pkg->adjourn,
+ contract_end => $cust_pkg->contract_end,
+ refnum => $cust_pkg->refnum,
+ discountnum => $cust_pkg->discountnum,
+ waive_setup => $cust_pkg->waive_setup,
+ });
+ if ( $old and $opt->{'keep_dates'} ) {
+ foreach (qw(setup bill last_bill)) {
+ $new->set($_, $old->get($_));
+ }
+ }
+ $error = $new->insert( allow_pkgpart => $same_pkgpart );
+ # transfer services
+ if ( $old ) {
+ $error ||= $old->transfer($new);
+ }
+ if ( $error and $error > 0 ) {
+ # no reason why this should ever fail, but still...
+ $error = "Unable to transfer all services from supplemental package ".
+ $old->pkgnum;
+ }
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ push @new_supp_pkgs, $new;
+ }
+ } # if !$opt->{'cust_pkg'}
+ # because if there is one, then supplemental packages would already
+ # have been created for it.
#Good to go, cancel old package. Notify 'cancel' of whether to credit
#remaining time.
#outstanding usage) if we are keeping dates (i.e. location changing),
#because the new package will be billed for the same date range.
#Supplemental packages are also canceled here.
+
+ # during scheduled changes, avoid canceling the package we just
+ # changed to (duh)
+ $self->set('change_to_pkgnum' => '');
+
$error = $self->cancel(
quiet => 1,
unused_credit => $unused_credit,
nobill => $keep_dates,
change_custnum => ( $self->custnum != $custnum ? $custnum : '' ),
+ no_delay_cancel => 1,
);
if ($error) {
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "canceling old package: $error";
}
if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "billing new package: $error";
}
}
}
-=item set_quantity QUANTITY
+=item change_later OPTION => VALUE...
-Change the package's quantity field. This is the one package property
-that can safely be changed without canceling and reordering the package
-(because it doesn't affect tax eligibility). Returns an error or an
-empty string.
+Schedule a package change for a later date. This actually orders the new
+package immediately, but sets its start date for a future date, and sets
+the current package to expire on the same date.
-=cut
+If the package is already scheduled for a change, this can be called with
+'start_date' to change the scheduled date, or with pkgpart and/or
+locationnum to modify the package change. To cancel the scheduled change
+entirely, see C<abort_change>.
-sub set_quantity {
- my $self = shift;
- $self = $self->replace_old; # just to make sure
- my $qty = shift;
- ($qty =~ /^\d+$/ and $qty > 0) or return "bad package quantity $qty";
- $self->set('quantity' => $qty);
- $self->replace;
-}
+Options include:
-use Storable 'thaw';
-use MIME::Base64;
-sub process_bulk_cust_pkg {
- my $job = shift;
- my $param = thaw(decode_base64(shift));
- warn Dumper($param) if $DEBUG;
+=over 4
- my $old_part_pkg = qsearchs('part_pkg',
- { pkgpart => $param->{'old_pkgpart'} });
- my $new_part_pkg = qsearchs('part_pkg',
- { pkgpart => $param->{'new_pkgpart'} });
- die "Must select a new package type\n" unless $new_part_pkg;
- #my $keep_dates = $param->{'keep_dates'} || 0;
- my $keep_dates = 1; # there is no good reason to turn this off
+=item start_date
+
+The date for the package change. Required, and must be in the future.
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
+=item pkgpart
+
+=item locationnum
+
+=item quantity
+
+The pkgpart. locationnum, and quantity of the new package, with the same
+meaning as in C<change>.
+
+=back
+
+=cut
+
+sub change_later {
+ my $self = shift;
+ my $opt = ref($_[0]) ? shift : { @_ };
my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
+ my $cust_main = $self->cust_main;
- my $i = 0;
- foreach my $old_cust_pkg ( @cust_pkgs ) {
+ my $date = delete $opt->{'start_date'} or return 'start_date required';
+
+ if ( $date <= time ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "start_date $date is in the past";
+ }
+
+ my $error;
+
+ if ( $self->change_to_pkgnum ) {
+ my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
+ my $new_pkgpart = $opt->{'pkgpart'}
+ if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $change_to->pkgpart;
+ my $new_locationnum = $opt->{'locationnum'}
+ if $opt->{'locationnum'} and $opt->{'locationnum'} != $change_to->locationnum;
+ my $new_quantity = $opt->{'quantity'}
+ if $opt->{'quantity'} and $opt->{'quantity'} != $change_to->quantity;
+ if ( $new_pkgpart or $new_locationnum or $new_quantity ) {
+ # it hasn't been billed yet, so in principle we could just edit
+ # it in place (w/o a package change), but that's bad form.
+ # So change the package according to the new options...
+ my $err_or_pkg = $change_to->change(%$opt);
+ if ( ref $err_or_pkg ) {
+ # Then set that package up for a future start.
+ $self->set('change_to_pkgnum', $err_or_pkg->pkgnum);
+ $self->set('expire', $date); # in case it's different
+ $err_or_pkg->set('start_date', $date);
+ $err_or_pkg->set('change_date', '');
+ $err_or_pkg->set('change_pkgnum', '');
+
+ $error = $self->replace ||
+ $err_or_pkg->replace ||
+ $change_to->cancel('no_delay_cancel' => 1) ||
+ $change_to->delete;
+ } else {
+ $error = $err_or_pkg;
+ }
+ } else { # change the start date only.
+ $self->set('expire', $date);
+ $change_to->set('start_date', $date);
+ $error = $self->replace || $change_to->replace;
+ }
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ } else {
+ $dbh->commit if $oldAutoCommit;
+ return '';
+ }
+ } # if $self->change_to_pkgnum
+
+ my $new_pkgpart = $opt->{'pkgpart'}
+ if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart;
+ my $new_locationnum = $opt->{'locationnum'}
+ if $opt->{'locationnum'} and $opt->{'locationnum'} != $self->locationnum;
+ my $new_quantity = $opt->{'quantity'}
+ if $opt->{'quantity'} and $opt->{'quantity'} != $self->quantity;
+
+ return '' unless $new_pkgpart or $new_locationnum or $new_quantity; # wouldn't do anything
+
+ # allow $opt->{'locationnum'} = '' to specifically set it to null
+ # (i.e. customer default location)
+ $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
+
+ my $new = FS::cust_pkg->new( {
+ custnum => $self->custnum,
+ locationnum => $opt->{'locationnum'},
+ start_date => $date,
+ map { $_ => ( $opt->{$_} || $self->$_() ) }
+ qw( pkgpart quantity refnum salesnum )
+ } );
+ $error = $new->insert('change' => 1,
+ 'allow_pkgpart' => ($new_pkgpart ? 0 : 1));
+ if ( !$error ) {
+ $self->set('change_to_pkgnum', $new->pkgnum);
+ $self->set('expire', $date);
+ $error = $self->replace;
+ }
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ } else {
+ $dbh->commit if $oldAutoCommit;
+ }
+
+ $error;
+}
+
+=item abort_change
+
+Cancels a future package change scheduled by C<change_later>.
+
+=cut
+
+sub abort_change {
+ my $self = shift;
+ my $pkgnum = $self->change_to_pkgnum;
+ my $change_to = FS::cust_pkg->by_key($pkgnum) if $pkgnum;
+ my $error;
+ if ( $change_to ) {
+ $error = $change_to->cancel || $change_to->delete;
+ return $error if $error;
+ }
+ $self->set('change_to_pkgnum', '');
+ $self->set('expire', '');
+ $self->replace;
+}
+
+=item set_quantity QUANTITY
+
+Change the package's quantity field. This is one of the few package properties
+that can safely be changed without canceling and reordering the package
+(because it doesn't affect tax eligibility). Returns an error or an
+empty string.
+
+=cut
+
+sub set_quantity {
+ my $self = shift;
+ $self = $self->replace_old; # just to make sure
+ $self->quantity(shift);
+ $self->replace;
+}
+
+=item set_salesnum SALESNUM
+
+Change the package's salesnum (sales person) field. This is one of the few
+package properties that can safely be changed without canceling and reordering
+the package (because it doesn't affect tax eligibility). Returns an error or
+an empty string.
+
+=cut
+
+sub set_salesnum {
+ my $self = shift;
+ $self = $self->replace_old; # just to make sure
+ $self->salesnum(shift);
+ $self->replace;
+ # XXX this should probably reassign any credit that's already been given
+}
+
+=item modify_charge OPTIONS
+
+Change the properties of a one-time charge. The following properties can
+be changed this way:
+- pkg: the package description
+- classnum: the package class
+- additional: arrayref of additional invoice details to add to this package
+
+and, I<if the charge has not yet been billed>:
+- start_date: the date when it will be billed
+- amount: the setup fee to be charged
+- quantity: the multiplier for the setup fee
+- separate_bill: whether to put the charge on a separate invoice
+
+If you pass 'adjust_commission' => 1, and the classnum changes, and there are
+commission credits linked to this charge, they will be recalculated.
+
+=cut
+
+sub modify_charge {
+ my $self = shift;
+ my %opt = @_;
+ my $part_pkg = $self->part_pkg;
+ my $pkgnum = $self->pkgnum;
+
+ my $dbh = dbh;
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+
+ return "Can't use modify_charge except on one-time charges"
+ unless $part_pkg->freq eq '0';
+
+ if ( length($opt{'pkg'}) and $part_pkg->pkg ne $opt{'pkg'} ) {
+ $part_pkg->set('pkg', $opt{'pkg'});
+ }
+
+ my %pkg_opt = $part_pkg->options;
+ my $pkg_opt_modified = 0;
+
+ $opt{'additional'} ||= [];
+ my $i;
+ my @old_additional;
+ foreach (grep /^additional/, keys %pkg_opt) {
+ ($i) = ($_ =~ /^additional_info(\d+)$/);
+ $old_additional[$i] = $pkg_opt{$_} if $i;
+ delete $pkg_opt{$_};
+ }
+
+ for ( $i = 0; exists($opt{'additional'}->[$i]); $i++ ) {
+ $pkg_opt{ "additional_info$i" } = $opt{'additional'}->[$i];
+ if (!exists($old_additional[$i])
+ or $old_additional[$i] ne $opt{'additional'}->[$i])
+ {
+ $pkg_opt_modified = 1;
+ }
+ }
+ $pkg_opt_modified = 1 if (scalar(@old_additional) - 1) != $i;
+ $pkg_opt{'additional_count'} = $i if $i > 0;
+
+ my $old_classnum;
+ if ( exists($opt{'classnum'}) and $part_pkg->classnum ne $opt{'classnum'} )
+ {
+ # remember it
+ $old_classnum = $part_pkg->classnum;
+ $part_pkg->set('classnum', $opt{'classnum'});
+ }
+
+ if ( !$self->get('setup') ) {
+ # not yet billed, so allow amount, setup_cost, quantity, start_date,
+ # and separate_bill
+
+ if ( exists($opt{'amount'})
+ and $part_pkg->option('setup_fee') != $opt{'amount'}
+ and $opt{'amount'} > 0 ) {
+
+ $pkg_opt{'setup_fee'} = $opt{'amount'};
+ $pkg_opt_modified = 1;
+ }
+
+ if ( exists($opt{'setup_cost'})
+ and $part_pkg->setup_cost != $opt{'setup_cost'}
+ and $opt{'setup_cost'} > 0 ) {
+
+ $part_pkg->set('setup_cost', $opt{'setup_cost'});
+ }
+
+ if ( exists($opt{'quantity'})
+ and $opt{'quantity'} != $self->quantity
+ and $opt{'quantity'} > 0 ) {
+
+ $self->set('quantity', $opt{'quantity'});
+ }
+
+ if ( exists($opt{'start_date'})
+ and $opt{'start_date'} != $self->start_date ) {
+
+ $self->set('start_date', $opt{'start_date'});
+ }
+
+ if ( exists($opt{'separate_bill'})
+ and $opt{'separate_bill'} ne $self->separate_bill ) {
+
+ $self->set('separate_bill', $opt{'separate_bill'});
+ }
+
+
+ } # else simply ignore them; the UI shouldn't allow editing the fields
+
+
+ if ( exists($opt{'taxclass'})
+ and $part_pkg->taxclass ne $opt{'taxclass'}) {
+
+ $part_pkg->set('taxclass', $opt{'taxclass'});
+ }
+
+ my $error;
+ if ( $part_pkg->modified or $pkg_opt_modified ) {
+ # can we safely modify the package def?
+ # Yes, if it's not available for purchase, and this is the only instance
+ # of it.
+ if ( $part_pkg->disabled
+ and FS::cust_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 1
+ and FS::quotation_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 0
+ ) {
+ $error = $part_pkg->replace( options => \%pkg_opt );
+ } else {
+ # clone it
+ $part_pkg = $part_pkg->clone;
+ $part_pkg->set('disabled' => 'Y');
+ $error = $part_pkg->insert( options => \%pkg_opt );
+ # and associate this as yet-unbilled package to the new package def
+ $self->set('pkgpart' => $part_pkg->pkgpart);
+ }
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ if ($self->modified) { # for quantity or start_date change, or if we had
+ # to clone the existing package def
+ my $error = $self->replace;
+ return $error if $error;
+ }
+ if (defined $old_classnum) {
+ # fix invoice grouping records
+ my $old_catname = $old_classnum
+ ? FS::pkg_class->by_key($old_classnum)->categoryname
+ : '';
+ my $new_catname = $opt{'classnum'}
+ ? $part_pkg->pkg_class->categoryname
+ : '';
+ if ( $old_catname ne $new_catname ) {
+ foreach my $cust_bill_pkg ($self->cust_bill_pkg) {
+ # (there should only be one...)
+ my @display = qsearch( 'cust_bill_pkg_display', {
+ 'billpkgnum' => $cust_bill_pkg->billpkgnum,
+ 'section' => $old_catname,
+ });
+ foreach (@display) {
+ $_->set('section', $new_catname);
+ $error = $_->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ } # foreach $cust_bill_pkg
+ }
+
+ if ( $opt{'adjust_commission'} ) {
+ # fix commission credits...tricky.
+ foreach my $cust_event ($self->cust_event) {
+ my $part_event = $cust_event->part_event;
+ foreach my $table (qw(sales agent)) {
+ my $class =
+ "FS::part_event::Action::Mixin::credit_${table}_pkg_class";
+ my $credit = qsearchs('cust_credit', {
+ 'eventnum' => $cust_event->eventnum,
+ });
+ if ( $part_event->isa($class) ) {
+ # Yes, this results in current commission rates being applied
+ # retroactively to a one-time charge. For accounting purposes
+ # there ought to be some kind of time limit on doing this.
+ my $amount = $part_event->_calc_credit($self);
+ if ( $credit and $credit->amount ne $amount ) {
+ # Void the old credit.
+ $error = $credit->void('Package class changed');
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$error (adjusting commission credit)";
+ }
+ }
+ # redo the event action to recreate the credit.
+ local $@ = '';
+ eval { $part_event->do_action( $self, $cust_event ) };
+ if ( $@ ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $@;
+ }
+ } # if $part_event->isa($class)
+ } # foreach $table
+ } # foreach $cust_event
+ } # if $opt{'adjust_commission'}
+ } # if defined $old_classnum
+
+ $dbh->commit if $oldAutoCommit;
+ '';
+}
+
+
+
+use Data::Dumper;
+sub process_bulk_cust_pkg {
+ my $job = shift;
+ my $param = shift;
+ warn Dumper($param) if $DEBUG;
+
+ my $old_part_pkg = qsearchs('part_pkg',
+ { pkgpart => $param->{'old_pkgpart'} });
+ my $new_part_pkg = qsearchs('part_pkg',
+ { pkgpart => $param->{'new_pkgpart'} });
+ die "Must select a new package type\n" unless $new_part_pkg;
+ #my $keep_dates = $param->{'keep_dates'} || 0;
+ my $keep_dates = 1; # there is no good reason to turn this off
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
+
+ my $i = 0;
+ foreach my $old_cust_pkg ( @cust_pkgs ) {
$i++;
$job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
if ( $old_cust_pkg->getfield('cancel') ) {
$self->part_pkg->calc_recur($self, @_);
}
+=item base_setup
+
+Calls the I<base_setup> of the FS::part_pkg object associated with this billing
+item.
+
+=cut
+
+sub base_setup {
+ my $self = shift;
+ $self->part_pkg->base_setup($self, @_);
+}
+
=item base_recur
Calls the I<base_recur> of the FS::part_pkg object associated with this billing
sub set_cust_pkg_detail {
my( $self, $detailtype, @details ) = @_;
- 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;
=item cust_event
-Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
+Returns the customer billing events (see L<FS::cust_event>) for this invoice.
=cut
=item num_cust_event
-Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
+Returns the number of customer billing events (see L<FS::cust_event>) for this package.
=cut
#false laziness w/cust_bill.pm
sub num_cust_event {
my $self = shift;
- my $sql =
- "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
- " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
+ my $sql = "SELECT COUNT(*) ". $self->_from_cust_event_where;
+ $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref->[0];
+}
+
+=item exists_cust_event
+
+Returns true if there are customer billing events (see L<FS::cust_event>) for this package. More efficient than using num_cust_event.
+
+=cut
+
+sub exists_cust_event {
+ my $self = shift;
+ my $sql = "SELECT 1 ". $self->_from_cust_event_where. " LIMIT 1";
+ my $row = $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref;
+ $row ? $row->[0] : '';
+}
+
+sub _from_cust_event_where {
+ #my $self = shift;
+ " FROM cust_event JOIN part_event USING ( eventpart ) ".
+ " WHERE tablenum = ? AND eventtable = 'cust_pkg' ";
+}
+
+sub _prep_ex {
+ my( $self, $sql, @args ) = @_;
my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
- $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
- $sth->fetchrow_arrayref->[0];
+ $sth->execute(@args) or die $sth->errstr. " executing $sql";
+ $sth;
+}
+
+=item part_pkg_currency_option OPTIONNAME
+
+Returns a two item list consisting of the currency of this customer, if any,
+and a value for the provided option. If the customer has a currency, the value
+is the option value the given name and the currency (see
+L<FS::part_pkg_currency>). Otherwise, if the customer has no currency, is the
+regular option value for the given name (see L<FS::part_pkg_option>).
+
+=cut
+
+sub part_pkg_currency_option {
+ my( $self, $optionname ) = @_;
+ my $part_pkg = $self->part_pkg;
+ if ( my $currency = $self->cust_main->currency ) {
+ ($currency, $part_pkg->part_pkg_currency_option($currency, $optionname) );
+ } else {
+ ('', $part_pkg->option($optionname) );
+ }
}
=item cust_svc [ SVCPART ] (old, deprecated usage)
=item cust_svc [ OPTION => VALUE ... ] (current usage)
+=item cust_svc_unsorted [ OPTION => VALUE ... ]
+
Returns the services for this package, as FS::cust_svc objects (see
L<FS::cust_svc>). Available options are svcpart and svcdb. If either is
spcififed, returns only the matching services.
+As an optimization, use the cust_svc_unsorted version if you are not displaying
+the results.
+
=cut
sub cust_svc {
my $self = shift;
+ cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
+ $self->_sort_cust_svc( $self->cust_svc_unsorted_arrayref(@_) );
+}
+
+sub cust_svc_unsorted {
+ my $self = shift;
+ @{ $self->cust_svc_unsorted_arrayref(@_) };
+}
- return () unless $self->num_cust_svc(@_);
+sub cust_svc_unsorted_arrayref {
+ my $self = shift;
+
+ return [] unless $self->num_cust_svc(@_);
my %opt = ();
if ( @_ && $_[0] =~ /^\d+/ ) {
$search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} );
}
- cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
-
- #if ( $self->{'_svcnum'} ) {
- # values %{ $self->{'_svcnum'}->cache };
- #} else {
- $self->_sort_cust_svc( [ qsearch(\%search) ] );
- #}
+ [ qsearch(\%search) ];
}
if $DEBUG;
my ($end, $start, $mode) = @_;
+
+ local($FS::Record::qsearch_qualify_columns) = 0;
+
my @cust_svc = $self->_sort_cust_svc(
[ qsearch( 'h_cust_svc',
{ 'pkgnum' => $self->pkgnum, },
FS::h_cust_svc->sql_h_search(@_),
) ]
);
+
if ( defined($mode) && $mode eq 'I' ) {
my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
my $sort =
sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
+ my %pkg_svc = map { $_->svcpart => $_ }
+ qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
+
map { $_->[0] }
sort $sort
map {
- my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
- 'svcpart' => $_->svcpart } );
+ my $pkg_svc = $pkg_svc{ $_->svcpart } || '';
[ $_,
$pkg_svc ? $pkg_svc->primary_svc : '',
$pkg_svc ? $pkg_svc->quantity : 0,
=over 4
-=item num_cust_svc (count)
+=item num_cust_svc
-=item num_avail (quantity - count)
+(count)
-=item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
+=item num_avail
+
+(quantity - count)
+
+=item cust_pkg_svc
+
+(services) - array reference containing the provisioned services, as cust_svc objects
=back
-Accepts one option: summarize_size. If specified and non-zero, will omit the
-extra cust_pkg_svc option for objects where num_cust_svc is this size or
-greater.
+Accepts two options:
+
+=over 4
+
+=item summarize_size
+
+If true, will omit the extra cust_pkg_svc option for objects where num_cust_svc
+is this size or greater.
+
+=item hide_discontinued
+
+If true, will omit looking for services that are no longer avaialble in the
+package definition.
+
+=back
=cut
$part_svc;
} $self->part_pkg->pkg_svc;
- #extras
- push @part_svc, map {
- my $part_svc = $_;
- my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
- $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
- $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
- $part_svc->{'Hash'}{'cust_pkg_svc'} =
- $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
- $part_svc;
- } $self->extra_part_svc;
+ unless ( $opt{hide_discontinued} ) {
+ #extras
+ push @part_svc, map {
+ my $part_svc = $_;
+ my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
+ $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
+ $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
+ $part_svc->{'Hash'}{'cust_pkg_svc'} =
+ $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
+ $part_svc;
+ } $self->extra_part_svc;
+ }
@part_svc;
=over 4
+=item on hold
+
=item not yet billed
=item one-time charge
my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
return 'cancelled' if $self->get('cancel');
+ return 'on hold' if $self->susp && ! $self->setup;
return 'suspended' if $self->susp;
return 'not yet billed' unless $self->setup;
return 'one-time charge' if $freq =~ /^(0|$)/;
=cut
tie my %statuscolor, 'Tie::IxHash',
+ 'on hold' => 'FF00F5', #brighter purple!
'not yet billed' => '009999', #teal? cyan?
- 'one-time charge' => '000000',
+ 'one-time charge' => '0000CC', #blue #'000000',
'active' => '00CC00',
'suspended' => 'FF9900',
'cancelled' => 'FF0000',
keys %statuscolor;
}
+sub statuscolors {
+ #my $self = shift;
+ \%statuscolor;
+}
+
=item statuscolor
Returns a hex triplet color string for this package's status.
$statuscolor{$self->status};
}
+=item is_status_delay_cancel
+
+Returns true if part_pkg has option delay_cancel,
+cust_pkg status is 'suspended' and expire is set
+to cancel package within the next day (or however
+many days are set in global config part_pkg-delay_cancel-days.
+
+Accepts option I<part_pkg-delay_cancel-days> which should be
+the value of the config setting, to avoid looking it up again.
+
+This is not a real status, this only meant for hacking display
+values, because otherwise treating the package as suspended is
+really the whole point of the delay_cancel option.
+
+=cut
+
+sub is_status_delay_cancel {
+ my ($self,%opt) = @_;
+ if ( $self->main_pkgnum and $self->pkglinknum ) {
+ return $self->main_pkg->is_status_delay_cancel;
+ }
+ return 0 unless $self->part_pkg->option('delay_cancel',1);
+ return 0 unless $self->status eq 'suspended';
+ return 0 unless $self->expire;
+ my $expdays = $opt{'part_pkg-delay_cancel-days'};
+ unless ($expdays) {
+ my $conf = new FS::Conf;
+ $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
+ }
+ my $expsecs = 60*60*24*$expdays;
+ return 0 unless $self->expire < time + $expsecs;
+ return 1;
+}
+
=item pkg_label
Returns a label for this package. (Currently "pkgnum: pkg - comment" or
sub pkg_label {
my $self = shift;
- my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
+ my $label = $self->part_pkg->pkg_comment( cust_pkg=>$self, nopkgpart=>1 );
$label = $self->pkgnum. ": $label"
if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
$label;
Returns the parent customer object (see L<FS::cust_main>).
-=cut
-
-sub cust_main {
- my $self = shift;
- qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-}
-
=item balance
Returns the balance for this specific package, when using
sub tax_location {
my $self = shift;
- FS::cust_location->by_key( $self->tax_locationnum )
+ my $conf = FS::Conf->new;
+ if ( $conf->exists('tax-pkg_address') and $self->locationnum ) {
+ return FS::cust_location->by_key($self->locationnum);
+ }
+ elsif ( $conf->exists('tax-ship_address') ) {
+ return $self->cust_main->ship_location;
+ }
+ else {
+ return $self->cust_main->bill_location;
+ }
}
=item seconds_since TIMESTAMP
foreach my $cust_svc (
grep {
my $part_svc = $_->part_svc;
- $part_svc->svcdb eq 'svc_acct'
- && scalar($part_svc->part_export_usage);
+ scalar($part_svc->part_export_usage);
} $self->cust_svc
) {
$sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
return ('Package does not exist: '.$dest_pkgnum) unless $dest;
foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
- $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
+ $target{$pkg_svc->svcpart} = $pkg_svc->quantity * ( $dest->quantity || 1 );
}
foreach my $cust_svc ($dest->cust_svc) {
}
}
+ my $error;
foreach my $cust_svc ($self->cust_svc) {
+ my $svcnum = $cust_svc->svcnum;
if($target{$cust_svc->svcpart} > 0
or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
$target{$cust_svc->svcpart}--;
my $new = new FS::cust_svc { $cust_svc->hash };
$new->pkgnum($dest_pkgnum);
- my $error = $new->replace($cust_svc);
- return $error if $error;
+ $error = $new->replace($cust_svc);
} elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
if ( $DEBUG ) {
warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
my $new = new FS::cust_svc { $cust_svc->hash };
$new->svcpart($change_svcpart);
$new->pkgnum($dest_pkgnum);
- my $error = $new->replace($cust_svc);
- return $error if $error;
+ $error = $new->replace($cust_svc);
} else {
$remaining++;
}
} else {
$remaining++
}
+ if ( $error ) {
+ my @label = $cust_svc->label;
+ return "$label[0] $label[1]: $error";
+ }
}
return $remaining;
}
-=item reexport
+=item grab_svcnums SVCNUM, SVCNUM ...
-This method is deprecated. See the I<depend_jobnum> option to the insert and
+Change the pkgnum for the provided services to this packages. If there is an
+error, returns the error, otherwise returns false.
+
+=cut
+
+sub grab_svcnums {
+ my $self = shift;
+ my @svcnum = @_;
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ foreach my $svcnum (@svcnum) {
+ my $cust_svc = qsearchs('cust_svc', { svcnum=>$svcnum } ) or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "unknown svcnum $svcnum";
+ };
+ $cust_svc->pkgnum( $self->pkgnum );
+ my $error = $cust_svc->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
+=item reexport
+
+This method is deprecated. See the I<depend_jobnum> option to the insert and
order_pkgs methods in FS::cust_main for a better way to defer provisioning.
=cut
+#looks like this is still used by the order_pkg and change_pkg methods in
+# ClientAPI/MyAccount, need to look into those before removing
sub reexport {
my $self = shift;
- 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;
}
+=item export_pkg_change OLD_CUST_PKG
+
+Calls the "pkg_change" export action for all services attached to this package.
+
+=cut
+
+sub export_pkg_change {
+ my( $self, $old ) = ( shift, shift );
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ foreach my $svc_x ( map $_->svc_x, $self->cust_svc ) {
+ my $error = $svc_x->export('pkg_change', $self, $old);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
=item insert_reason
Associates this package with a (suspension or cancellation) reason (see
$reasonnum = $reason->reasonnum;
} else {
- return "Unparsable reason: ". $options{'reason'};
+ return "Unparseable reason: ". $options{'reason'};
}
my $cust_pkg_reason =
}
}
-=item cust_pkg_discount
+=item apply_usageprice
=cut
-sub cust_pkg_discount {
+sub apply_usageprice {
my $self = shift;
- qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = '';
+
+ foreach my $cust_pkg_usageprice ( $self->cust_pkg_usageprice ) {
+ $error ||= $cust_pkg_usageprice->apply;
+ }
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ die "error applying part_pkg_usageprice add-ons, pkgnum ". $self->pkgnum.
+ ": $error\n";
+ } else {
+ $dbh->commit if $oldAutoCommit;
+ }
+
+
}
+=item cust_pkg_discount
+
=item cust_pkg_discount_active
=cut
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:
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;
minutes => min($cust_pkg_usage->minutes, $minutes),
});
$cust_pkg_usage->set('minutes',
- sprintf('%.0f', $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes)
+ $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;
AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
"; }
+=item on_hold_sql
+
+Returns an SQL expression identifying on-hold packages.
+
+=cut
+
+sub on_hold_sql {
+ #$_[0]->recurring_sql(). ' AND '.
+ "
+ ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
+ AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
+ AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
+ ";
+}
+
=item susp_sql
=item suspended_sql
"
( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
+ AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
";
}
sub status_sql {
"CASE
WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
+ WHEN ( cust_pkg.susp IS NOT NULL AND cust_pkg.setup IS NULL ) THEN 'on hold'
WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
WHEN ".onetime_sql()." THEN 'one-time charge'
END"
}
-=item search HASHREF
-
-(Class method)
-
-Returns a qsearch hash expression to search for parameters specified in HASHREF.
-Valid parameters are
-
-=over 4
-
-=item agentnum
-
-=item magic
-
-active, inactive, suspended, cancel (or cancelled)
-
-=item status
-
-active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
-
-=item custom
-
- boolean selects custom packages
-
-=item classnum
-
-=item pkgpart
-
-pkgpart or arrayref or hashref of pkgparts
-
-=item setup
-
-arrayref of beginning and ending epoch date
-
-=item last_bill
-
-arrayref of beginning and ending epoch date
-
-=item bill
-
-arrayref of beginning and ending epoch date
-
-=item adjourn
-
-arrayref of beginning and ending epoch date
-
-=item susp
-
-arrayref of beginning and ending epoch date
-
-=item expire
-
-arrayref of beginning and ending epoch date
-
-=item cancel
-
-arrayref of beginning and ending epoch date
-
-=item query
-
-pkgnum or APKG_pkgnum
-
-=item cust_fields
-
-a value suited to passing to FS::UI::Web::cust_header
-
-=item CurrentUser
-
-specifies the user for agent virtualization
-
-=item fcc_line
-
-boolean; if true, returns only packages with more than 0 FCC phone lines.
-
-=item state, country
-
-Limit to packages with a service location in the specified state and country.
-For FCC 477 reporting, mostly.
-
-=back
-
-=cut
-
-sub search {
- my ($class, $params) = @_;
- my @where = ();
-
- ##
- # parse agent
- ##
-
- if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
- push @where,
- "cust_main.agentnum = $1";
- }
-
- ##
- # parse custnum
- ##
-
- if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
- push @where,
- "cust_pkg.custnum = $1";
- }
-
- ##
- # custbatch
- ##
-
- if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
- push @where,
- "cust_pkg.pkgbatch = '$1'";
- }
-
- ##
- # parse status
- ##
-
- if ( $params->{'magic'} eq 'active'
- || $params->{'status'} eq 'active' ) {
-
- push @where, FS::cust_pkg->active_sql();
-
- } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
- || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
-
- push @where, FS::cust_pkg->not_yet_billed_sql();
-
- } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
- || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
-
- push @where, FS::cust_pkg->inactive_sql();
-
- } elsif ( $params->{'magic'} eq 'suspended'
- || $params->{'status'} eq 'suspended' ) {
-
- push @where, FS::cust_pkg->suspended_sql();
-
- } elsif ( $params->{'magic'} =~ /^cancell?ed$/
- || $params->{'status'} =~ /^cancell?ed$/ ) {
-
- push @where, FS::cust_pkg->cancelled_sql();
-
- }
-
- ###
- # parse package class
- ###
-
- if ( exists($params->{'classnum'}) ) {
-
- my @classnum = ();
- if ( ref($params->{'classnum'}) ) {
-
- if ( ref($params->{'classnum'}) eq 'HASH' ) {
- @classnum = grep $params->{'classnum'}{$_}, keys %{ $params->{'classnum'} };
- } elsif ( ref($params->{'classnum'}) eq 'ARRAY' ) {
- @classnum = @{ $params->{'classnum'} };
- } else {
- die 'unhandled classnum ref '. $params->{'classnum'};
- }
-
-
- } elsif ( $params->{'classnum'} =~ /^(\d*)$/ && $1 ne '0' ) {
- @classnum = ( $1 );
- }
-
- if ( @classnum ) {
-
- my @c_where = ();
- my @nums = grep $_, @classnum;
- push @c_where, 'part_pkg.classnum IN ('. join(',',@nums). ')' if @nums;
- my $null = scalar( grep { $_ eq '' } @classnum );
- push @c_where, 'part_pkg.classnum IS NULL' if $null;
-
- if ( scalar(@c_where) == 1 ) {
- push @where, @c_where;
- } elsif ( @c_where ) {
- push @where, ' ( '. join(' OR ', @c_where). ' ) ';
- }
-
- }
-
-
- }
-
- ###
- # parse package report options
- ###
-
- my @report_option = ();
- if ( exists($params->{'report_option'}) ) {
- if ( ref($params->{'report_option'}) eq 'ARRAY' ) {
- @report_option = @{ $params->{'report_option'} };
- } elsif ( $params->{'report_option'} =~ /^([,\d]*)$/ ) {
- @report_option = split(',', $1);
- }
-
- }
-
- if (@report_option) {
- # this will result in the empty set for the dangling comma case as it should
- push @where,
- map{ "0 < ( SELECT count(*) FROM part_pkg_option
- WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
- AND optionname = 'report_option_$_'
- AND optionvalue = '1' )"
- } @report_option;
- }
-
- foreach my $any ( grep /^report_option_any/, keys %$params ) {
-
- my @report_option_any = ();
- if ( ref($params->{$any}) eq 'ARRAY' ) {
- @report_option_any = @{ $params->{$any} };
- } elsif ( $params->{$any} =~ /^([,\d]*)$/ ) {
- @report_option_any = split(',', $1);
- }
-
- if (@report_option_any) {
- # this will result in the empty set for the dangling comma case as it should
- push @where, ' ( '. join(' OR ',
- map{ "0 < ( SELECT count(*) FROM part_pkg_option
- WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
- AND optionname = 'report_option_$_'
- AND optionvalue = '1' )"
- } @report_option_any
- ). ' ) ';
- }
-
- }
-
- ###
- # parse custom
- ###
-
- push @where, "part_pkg.custom = 'Y'" if $params->{custom};
-
- ###
- # parse fcc_line
- ###
-
- push @where, "(part_pkg.fcc_ds0s > 0 OR pkg_class.fcc_ds0s > 0)"
- if $params->{fcc_line};
-
- ###
- # parse censustract
- ###
-
- if ( exists($params->{'censustract'}) ) {
- $params->{'censustract'} =~ /^([.\d]*)$/;
- my $censustract = "cust_location.censustract = '$1'";
- $censustract .= ' OR cust_location.censustract is NULL' unless $1;
- push @where, "( $censustract )";
- }
-
- ###
- # parse censustract2
- ###
- if ( exists($params->{'censustract2'})
- && $params->{'censustract2'} =~ /^(\d*)$/
- )
- {
- if ($1) {
- push @where, "cust_location.censustract LIKE '$1%'";
- } else {
- push @where,
- "( cust_location.censustract = '' OR cust_location.censustract IS NULL )";
- }
- }
-
- ###
- # parse country/state
- ###
- for (qw(state country)) { # parsing rules are the same for these
- if ( exists($params->{$_})
- && uc($params->{$_}) =~ /^([A-Z]{2})$/ )
- {
- # XXX post-2.3 only--before that, state/country may be in cust_main
- push @where, "cust_location.$_ = '$1'";
- }
- }
-
- ###
- # parse part_pkg
- ###
-
- if ( ref($params->{'pkgpart'}) ) {
-
- my @pkgpart = ();
- if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
- @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
- } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
- @pkgpart = @{ $params->{'pkgpart'} };
- } else {
- die 'unhandled pkgpart ref '. $params->{'pkgpart'};
- }
-
- @pkgpart = grep /^(\d+)$/, @pkgpart;
-
- push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
-
- } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
- push @where, "pkgpart = $1";
- }
-
- ###
- # parse dates
- ###
-
- my $orderby = '';
-
- #false laziness w/report_cust_pkg.html
- my %disable = (
- 'all' => {},
- 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
- 'active' => { 'susp'=>1, 'cancel'=>1 },
- 'suspended' => { 'cancel' => 1 },
- 'cancelled' => {},
- '' => {},
- );
-
- if( exists($params->{'active'} ) ) {
- # This overrides all the other date-related fields
- my($beginning, $ending) = @{$params->{'active'}};
- push @where,
- "cust_pkg.setup IS NOT NULL",
- "cust_pkg.setup <= $ending",
- "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
- "NOT (".FS::cust_pkg->onetime_sql . ")";
- }
- else {
- foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) {
-
- next unless exists($params->{$field});
-
- my($beginning, $ending) = @{$params->{$field}};
-
- next if $beginning == 0 && $ending == 4294967295;
-
- push @where,
- "cust_pkg.$field IS NOT NULL",
- "cust_pkg.$field >= $beginning",
- "cust_pkg.$field <= $ending";
-
- $orderby ||= "ORDER BY cust_pkg.$field";
-
- }
- }
-
- $orderby ||= 'ORDER BY bill';
-
- ###
- # parse magic, legacy, etc.
- ###
-
- if ( $params->{'magic'} &&
- $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
- ) {
-
- $orderby = 'ORDER BY pkgnum';
-
- if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
- push @where, "pkgpart = $1";
- }
-
- } elsif ( $params->{'query'} eq 'pkgnum' ) {
-
- $orderby = 'ORDER BY pkgnum';
-
- } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
-
- $orderby = 'ORDER BY pkgnum';
-
- push @where, '0 < (
- SELECT count(*) FROM pkg_svc
- WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
- AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
- WHERE cust_svc.pkgnum = cust_pkg.pkgnum
- AND cust_svc.svcpart = pkg_svc.svcpart
- )
- )';
-
- }
-
- ##
- # setup queries, links, subs, etc. for the search
- ##
-
- # here is the agent virtualization
- if ($params->{CurrentUser}) {
- my $access_user =
- qsearchs('access_user', { username => $params->{CurrentUser} });
-
- if ($access_user) {
- push @where, $access_user->agentnums_sql('table'=>'cust_main');
- } else {
- push @where, "1=0";
- }
- } else {
- push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
- }
-
- my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
-
- my $addl_from = 'LEFT JOIN part_pkg USING ( pkgpart ) '.
- 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '.
- 'LEFT JOIN cust_location USING ( locationnum ) '.
- FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg');
-
- my $select;
- my $count_query;
- if ( $params->{'select_zip5'} ) {
- my $zip = 'cust_location.zip';
-
- $select = "DISTINCT substr($zip,1,5) as zip";
- $orderby = "ORDER BY substr($zip,1,5)";
- $count_query = "SELECT COUNT( DISTINCT substr($zip,1,5) )";
- } else {
- $select = join(', ',
- 'cust_pkg.*',
- ( map "part_pkg.$_", qw( pkg freq ) ),
- 'pkg_class.classname',
- 'cust_main.custnum AS cust_main_custnum',
- FS::UI::Web::cust_sql_fields(
- $params->{'cust_fields'}
- ),
- );
- $count_query = 'SELECT COUNT(*)';
- }
-
- $count_query .= " FROM cust_pkg $addl_from $extra_sql";
-
- my $sql_query = {
- 'table' => 'cust_pkg',
- 'hashref' => {},
- 'select' => $select,
- 'extra_sql' => $extra_sql,
- 'order_by' => $orderby,
- 'addl_from' => $addl_from,
- 'count_query' => $count_query,
- };
-
-}
-
=item fcc_477_count
Returns a list of two package counts. The first is a count of packages
=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
+Bulk cancel + order subroutine. Perhaps slightly deprecated, only used by the
+bulk cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
+
CUSTNUM is a customer (see L<FS::cust_main>)
PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
my $conf = new FS::Conf;
# Transactionize this whole mess
- 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;
$dbh->rollback if $oldAutoCommit;
return "Unable to transfer all services from package ".$old_pkg->pkgnum;
}
- $error = $old_pkg->cancel( quiet=>1 );
+ $error = $old_pkg->cancel( quiet=>1, 'no_delay_cancel'=>1 );
if ($error) {
$dbh->rollback;
return $error;
my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
# Transactionize this whole mess
- 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;
'';
}
+=item forward_emails
+
+Returns a hash of svcnums and corresponding email addresses
+for svc_acct services that can be used as source or dest
+for svc_forward services provisioned in this package.
+
+Accepts options I<svc_forward> OR I<svcnum> for a svc_forward
+service; if included, will ensure the current values of the
+specified service are included in the list, even if for some
+other reason they wouldn't be. If called as a class method
+with a specified service, returns only these current values.
+
+Caution: does not actually check if svc_forward services are
+available to be provisioned on this package.
+
+=cut
+
+sub forward_emails {
+ my $self = shift;
+ my %opt = @_;
+
+ #load optional service, thoroughly validated
+ die "Use svcnum or svc_forward, not both"
+ if $opt{'svcnum'} && $opt{'svc_forward'};
+ my $svc_forward = $opt{'svc_forward'};
+ $svc_forward ||= qsearchs('svc_forward',{ 'svcnum' => $opt{'svcnum'} })
+ if $opt{'svcnum'};
+ die "Specified service is not a forward service"
+ if $svc_forward && (ref($svc_forward) ne 'FS::svc_forward');
+ die "Specified service not found"
+ if ($opt{'svcnum'} || $opt{'svc_forward'}) && !$svc_forward;
+
+ my %email;
+
+ ## everything below was basically copied from httemplate/edit/svc_forward.cgi
+ ## with minimal refactoring, not sure why we can't just load all svc_accts for this custnum
+
+ #add current values from specified service, if there was one
+ if ($svc_forward) {
+ foreach my $method (qw( srcsvc_acct dstsvc_acct )) {
+ my $svc_acct = $svc_forward->$method();
+ $email{$svc_acct->svcnum} = $svc_acct->email if $svc_acct;
+ }
+ }
+
+ if (ref($self) eq 'FS::cust_pkg') {
+
+ #and including the rest for this customer
+ my($u_part_svc,@u_acct_svcparts);
+ foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
+ push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
+ }
+
+ my $custnum = $self->getfield('custnum');
+ foreach my $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
+ my $cust_pkgnum = $i_cust_pkg->getfield('pkgnum');
+ #now find the corresponding record(s) in cust_svc (for this pkgnum!)
+ foreach my $acct_svcpart (@u_acct_svcparts) {
+ foreach my $i_cust_svc (
+ qsearch( 'cust_svc', { 'pkgnum' => $cust_pkgnum,
+ 'svcpart' => $acct_svcpart } )
+ ) {
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $i_cust_svc->svcnum } );
+ $email{$svc_acct->svcnum} = $svc_acct->email;
+ }
+ }
+ }
+ }
+
+ return %email;
+}
+
# Used by FS::Upgrade to migrate to a new database.
sub _upgrade_data { # class method
my ($class, %opts) = @_;
my $sth = dbh->prepare($sql);
$sth->execute or die $sth->errstr;
}
+
+ # RT31194: supplemental package links that are deleted don't clean up
+ # linked records
+ my @pkglinknums = qsearch({
+ 'select' => 'DISTINCT cust_pkg.pkglinknum',
+ 'table' => 'cust_pkg',
+ 'addl_from' => ' LEFT JOIN part_pkg_link USING (pkglinknum) ',
+ 'extra_sql' => ' WHERE cust_pkg.pkglinknum IS NOT NULL
+ AND part_pkg_link.pkglinknum IS NULL',
+ });
+ foreach (@pkglinknums) {
+ my $pkglinknum = $_->pkglinknum;
+ warn "cleaning part_pkg_link #$pkglinknum\n";
+ my $part_pkg_link = FS::part_pkg_link->new({pkglinknum => $pkglinknum});
+ my $error = $part_pkg_link->remove_linked;
+ die $error if $error;
+ }
}
=back