}
}
- my @labels = ();
-
- foreach my $cust_svc (
- qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
- ) {
- my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
-
- $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
- $dbh->rollback if $oldAutoCommit;
- return "Illegal svcdb value in part_svc!";
- };
- my $svcdb = $1;
- require "FS/$svcdb.pm";
-
- 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";
+ 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;
+
+ my @labels = ();
+ foreach my $cust_svc ( @cust_svc ) {
+ $cust_svc->suspend( 'labels_arrayref' => \@labels );
+ }
# suspension fees: if there is a feepart, and it's not an unsuspend fee,
# and this is not a suspend-before-cancel
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{"change_$_"} = $self->$_()
foreach qw( pkgnum pkgpart locationnum );
- 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;
- }
-
if ( $opt->{'cust_pkg'} ) {
# treat changing to a package with a different pkgpart as a
# pkgpart change (because it is)
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 this date, regardless of anything
- # (the date of the package change is in a different field)
- $hash{'order_date'} = $self->getfield('order_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)
# 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};
# changed from this package.
$cust_pkg = $opt->{'cust_pkg'};
- foreach ( qw( pkgnum pkgpart locationnum ) ) {
- $cust_pkg->set("change_$_", $self->get($_));
+ # follow all the above rules for date changes, etc.
+ foreach (keys %hash) {
+ $cust_pkg->set($_, $hash{$_});
}
- $cust_pkg->set('change_date', $time);
+ # 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 {
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) = @_;
+ 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 $conf = new FS::Conf;
- my $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
+ 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 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) = @_;