use Time::Local qw( timelocal timelocal_nocheck );
use MIME::Entity;
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::cust_svc;
# for modify_charge
use FS::cust_credit;
+# temporary fix; remove this once (un)suspend admin notices are cleaned up
+use FS::Misc qw(send_email);
+
# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
# setup }
# because they load configuration by setting FS::UID::callback (see TODO)
our $upgrade = 0; #go away after setup+start dates cleaned up for old customers
-sub _cache {
- my $self = shift;
- my ( $hashref, $cache ) = @_;
- #if ( $hashref->{'pkgpart'} ) {
+sub _simplecache {
+ my( $self, $hashref ) = @_;
if ( $hashref->{'pkg'} ) {
- # #@{ $self->{'_pkgnum'} } = ();
- # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
- # $self->{'_pkgpart'} = $subcache;
- # #push @{ $self->{'_pkgnum'} },
- # FS::part_pkg->new_or_cached($hashref, $subcache);
$self->{'_pkgpart'} = FS::part_pkg->new($hashref);
}
+}
+
+sub _cache {
+ my $self = shift;
+ my ( $hashref, $cache ) = @_;
+# #if ( $hashref->{'pkgpart'} ) {
+# if ( $hashref->{'pkg'} ) {
+# # #@{ $self->{'_pkgnum'} } = ();
+# # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
+# # $self->{'_pkgpart'} = $subcache;
+# # #push @{ $self->{'_pkgnum'} },
+# # FS::part_pkg->new_or_cached($hashref, $subcache);
+# $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
+# }
if ( exists $hashref->{'svcnum'} ) {
#@{ $self->{'_pkgnum'} } = ();
my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
a delayed setup fee after a period of "free days", will also set the
start date to the end of that period.
+If the package has an automatic transfer rule (C<change_to_pkgnum>), then
+this will also order the package and set its start date.
+
=cut
sub set_initial_timers {
my $self = shift;
my $part_pkg = $self->part_pkg;
+ my $start = $self->start_date || $self->setup || time;
+
foreach my $action ( qw(expire adjourn contract_end) ) {
- my $months = $part_pkg->option("${action}_months",1);
+ my $months = $part_pkg->get("${action}_months");
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 an expire date and a change_to_pkgpart, set automatic
+ # package transfer
+ # (but don't call change_later, as that would call $self->replace, and we're
+ # probably in the middle of $self->insert right now)
+ if ( $part_pkg->expire_months and $part_pkg->change_to_pkgpart ) {
+ if ( $self->change_to_pkgnum ) {
+ # this can happen if a package is ordered on hold, scheduled for a
+ # future change _while on hold_, and then released from hold, causing
+ # the automatic transfer to schedule.
+ #
+ # what's correct behavior in that case? I think it's to disallow
+ # future-changing an on-hold package that has an automatic transfer.
+ # but if we DO get into this situation, let the manual package change
+ # win.
+ warn "pkgnum ".$self->pkgnum.": manual future package change blocks ".
+ "automatic transfer.\n";
+ } else {
+ my $change_to = FS::cust_pkg->new( {
+ start_date => $self->get('expire'),
+ pkgpart => $part_pkg->change_to_pkgpart,
+ map { $_ => $self->get($_) }
+ qw( custnum locationnum quantity refnum salesnum contract_end )
+ } );
+ my $error = $change_to->insert;
+
+ return $error if $error;
+ $self->set('change_to_pkgnum', $change_to->pkgnum);
+ }
+ }
+
# 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)
{
$self->start_date( $part_pkg->default_start_date );
}
+
'';
}
sub insert {
my( $self, %options ) = @_;
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
my $error;
$error = $self->check_pkgpart unless $options{'allow_pkgpart'};
- return $error if $error;
my $part_pkg = $self->part_pkg;
$self->set('start_date', '');
} else {
# set expire/adjourn/contract_end timers, and free days, if appropriate
- $self->set_initial_timers;
+ # and automatic package transfer, which can fail, so capture the result
+ $error = $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;
- my $dbh = dbh;
-
- $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
+ $error ||= $self->SUPER::insert($options{options} ? %{$options{options}} : ());
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
}
- if ( $self->discountnum ) {
+ if ( $self->setup_discountnum || $self->recur_discountnum ) {
my $error = $self->insert_discount();
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
=cut
+# this is still used internally to abort future package changes, so it
+# does need to work
+
sub delete {
my $self = shift;
+ # The following foreign keys to cust_pkg are not cleaned up here, and will
+ # cause package deletion to fail:
+ #
+ # cust_credit.pkgnum and commission_pkgnum (and cust_credit_void)
+ # cust_credit_bill.pkgnum
+ # cust_pay_pending.pkgnum
+ # cust_pay.pkgnum (and cust_pay_void)
+ # cust_bill_pay.pkgnum (wtf, shouldn't reference pkgnum)
+ # cust_pkg_usage.pkgnum
+ # cust_pkg.uncancel_pkgnum, change_pkgnum, main_pkgnum, and change_to_pkgnum
+
+ # cust_svc is handled by canceling the package before deleting it
+ # cust_pkg_option is handled via option_Common
+
my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
}
}
- #pkg_referral?
+ foreach my $pkg_referral ( $self->pkg_referral ) {
+ my $error = $pkg_referral->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
my $error = $self->SUPER::delete(@_);
if ( $error ) {
my( $self, %options ) = @_;
my $error;
- # pass all suspend/cancel actions to the main package
- # (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);
- }
+ # supplemental packages can now be separately canceled, though the UI
+ # shouldn't permit it
+ #
+ ## pass all suspend/cancel actions to the main package
+ ## (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);
+ #}
my $conf = new FS::Conf;
}
}
+ # if a reasonnum was passed, get the actual reason object so we can check
+ # unused_credit
+
+ my $reason;
+ if ($options{'reason'} =~ /^\d+$/) {
+ $reason = FS::reason->by_key($options{'reason'});
+ }
+
unless ($date) {
- # credit remaining time if appropriate
+ # credit remaining time if any of these are true:
+ # - unused_credit => 1 was passed (this happens when canceling a package
+ # for a package change when unused_credit_change is set)
+ # - no unused_credit option, and there is a cancel reason, and the cancel
+ # reason says to credit the package
+ # - no unused_credit option, and the package definition says to credit the
+ # package on cancellation
my $do_credit;
if ( exists($options{'unused_credit'}) ) {
$do_credit = $options{'unused_credit'};
- }
- else {
+ } elsif ( defined($reason) && $reason->unused_credit ) {
+ $do_credit = 1;
+ } else {
$do_credit = $self->part_pkg->option('unused_credit_cancel', 1);
}
if ( $do_credit ) {
$hash{main_pkgnum} = '';
}
+ # if there is a future package change scheduled, unlink from it (like
+ # abort_change) first, then delete it.
+ $hash{'change_to_pkgnum'} = '';
+
+ # save the package state
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;
$error = $msg_template->send( 'cust_main' => $self->cust_main,
'object' => $self );
}
- else {
- $error = send_email(
- '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?
}
my( $self, %options ) = @_;
my $error;
- # pass all suspend/cancel actions to the main package
+ # supplemental packages still can't be separately suspended, but silently
+ # exit instead of failing or passing the action to the main package (so
+ # that the "Suspend customer" action doesn't trip over the supplemental
+ # packages and die)
+
if ( $self->main_pkgnum and !$options{'from_main'} ) {
- return $self->main_pkg->suspend(%options);
+ return;
}
my $oldAutoCommit = $FS::UID::AutoCommit;
if (!$self->setup) {
# then this package is being released from on-hold status
- $self->set_initial_timers;
+ $error = $self->set_initial_timers;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
}
my @labels = ();
#option shouldn't be passed, throw error if it's non-empty
return "Cannot add contract end date when changing packages " . $self->pkgnum;
}
- if ($opt->{'start_date'} && ($opt->{'contract_end'} < $opt->{'start_date'})) {
- return "Contract end date is before change date";
- }
}
return '';
}
# 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->set_initial_timers;
}
# but if contract_end was explicitly specified, that overrides all else
$self->set('contract_end', $opt->{'contract_end'})
if $opt->{'contract_end'};
- $error = $self->replace;
+ $error ||= $self->replace;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "modifying package: $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) {
+ # transfer usage pricing add-ons, if we're not changing pkgpart or if they were specified
+ if ( $same_pkgpart || $opt->{'cust_pkg_usageprice'}) {
+ my @old_cust_pkg_usageprice;
+ if ($opt->{'cust_pkg_usageprice'}) {
+ @old_cust_pkg_usageprice = @{ $opt->{'cust_pkg_usageprice'} };
+ } else {
+ @old_cust_pkg_usageprice = $self->cust_pkg_usageprice;
+ }
+ foreach my $old_cust_pkg_usageprice (@old_cust_pkg_usageprice) {
my $new_cust_pkg_usageprice = new FS::cust_pkg_usageprice {
'pkgnum' => $cust_pkg->pkgnum,
'usagepricepart' => $old_cust_pkg_usageprice->usagepricepart,
$error = $self->replace ||
$err_or_pkg->replace ||
- $change_to->cancel('no_delay_cancel' => 1) ||
- $change_to->delete;
+ #because change() might've edited existing scheduled change in place
+ (($err_or_pkg->pkgnum == $change_to->pkgnum) ? '' :
+ $change_to->cancel('no_delay_cancel' => 1) ||
+ $change_to->delete);
} else {
$error = $err_or_pkg;
}
sub abort_change {
my $self = shift;
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+
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;
+ $error = $self->replace;
+ if ( $change_to ) {
+ $error ||= $change_to->cancel || $change_to->delete;
+ }
+
+ if ( $oldAutoCommit ) {
+ if ( $error ) {
+ dbh->rollback;
+ } else {
+ dbh->commit;
+ }
+ }
+
+ return $error;
}
=item set_quantity QUANTITY
package but not yet provisioned. Each FS::part_svc object also has an extra
field, I<num_avail>, which specifies the number of available services.
+Accepts option I<provision_hold>; if true, only returns part_svc for which the
+associated pkg_svc has the provision_hold flag set.
+
=cut
sub available_part_svc {
my $self = shift;
+ my %opt = @_;
my $pkg_quantity = $self->quantity || 1;
grep { $_->num_avail > 0 }
- map {
- my $part_svc = $_->part_svc;
- $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
- $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
-
- # more evil encapsulation breakage
- if($part_svc->{'Hash'}{'num_avail'} > 0) {
- my @exports = $part_svc->part_export_did;
- $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
- }
-
- $part_svc;
- }
- $self->part_pkg->pkg_svc;
+ map {
+ my $part_svc = $_->part_svc;
+ $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
+ $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
+
+ # more evil encapsulation breakage
+ if ($part_svc->{'Hash'}{'num_avail'} > 0) {
+ my @exports = $part_svc->part_export_did;
+ $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
+ }
+
+ $part_svc;
+ }
+ grep { $opt{'provision_hold'} ? $_->provision_hold : 1 }
+ $self->part_pkg->pkg_svc;
}
=item part_svc [ OPTION => VALUE ... ]
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
+This will look at the cust_pkg for a pseudo-field named "setup_discountnum",
+and if present, will create a setup discount. If the discountnum is -1,
+a new discount definition will be inserted using the value in
+"setup_discountnum_amount" or "setup_discountnum_percent". Likewise for recur.
If there is an error, returns the error, otherwise returns false.
#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,
- };
+ foreach my $x (qw(setup recur)) {
+ if ( my $discountnum = $self->get("${x}_discountnum") ) {
+ my $cust_pkg_discount = FS::cust_pkg_discount->new( {
+ 'pkgnum' => $self->pkgnum,
+ 'discountnum' => $discountnum,
+ 'setuprecur' => $x,
+ 'months_used' => 0,
+ 'end_date' => '', #XXX
+ #for the create a new discount case
+ 'amount' => $self->get("${x}_discountnum_amount"),
+ 'percent' => $self->get("${x}_discountnum_percent"),
+ 'months' => $self->get("${x}_discountnum_months"),
+ } );
+ if ( $x eq 'setup' ) {
+ $cust_pkg_discount->setup('Y');
+ $cust_pkg_discount->months('');
+ }
+ my $error = $cust_pkg_discount->insert;
+ return $error if $error;
+ }
+ }
- $cust_pkg_discount->insert;
+ '';
}
=item set_usage USAGE_VALUE_HASHREF