package FS::cust_pkg;
use strict;
-use vars qw(@ISA $disable_agentcheck $DEBUG);
+use vars qw(@ISA $disable_agentcheck @SVCDB_CANCEL_SEQ $DEBUG);
use FS::UID qw( getotaker dbh );
use FS::Record qw( qsearch qsearchs );
use FS::Misc qw( send_email );
$disable_agentcheck = 0;
+# The order in which to unprovision services.
+@SVCDB_CANCEL_SEQ = qw( svc_external
+ svc_www
+ svc_forward
+ svc_acct
+ svc_domain
+ svc_broadband );
+
sub _cache {
my $self = shift;
my ( $hashref, $cache ) = @_;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
+ my %svc;
foreach my $cust_svc (
- qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
+ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
) {
- my $error = $cust_svc->cancel;
+ push @{ $svc{$cust_svc->part_svc->svcdb} }, $cust_svc;
+ }
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error cancelling cust_svc: $error";
- }
+ foreach my $svcdb (@SVCDB_CANCEL_SEQ) {
+ foreach my $cust_svc (@{ $svc{$svcdb} }) {
+ my $error = $cust_svc->cancel;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error cancelling cust_svc: $error";
+ }
+ }
}
unless ( $self->getfield('cancel') ) {
sub cust_svc {
my $self = shift;
- if ( $self->{'_svcnum'} ) {
- values %{ $self->{'_svcnum'}->cache };
- } else {
+ #if ( $self->{'_svcnum'} ) {
+ # values %{ $self->{'_svcnum'}->cache };
+ #} else {
+ map { $_->[0] }
+ sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
+ map {
+ my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
+ 'svcpart' => $_->svcpart } );
+ [ $_,
+ $pkg_svc ? $pkg_svc->primary_svc : '',
+ $pkg_svc ? $pkg_svc->quantity : 0,
+ ];
+ }
qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
- }
+ #}
}
=item labels
}
-=item transfer DEST_PKGNUM
+=item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
Transfers as many services as possible from this package to another package.
-The destination package must already exist. Services are moved only if
-the destination allows services with the correct I<svcpart> (not svcdb).
+
+The destination package can be specified by pkgnum by passing an FS::cust_pkg
+object. The destination package must already exist.
+
+Services are moved only if the destination allows services with the correct
+I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
+this option with caution! No provision is made for export differences
+between the old and new service definitions. Probably only should be used
+when your exports for all service definitions of a given svcdb are identical.
+(attempt a transfer without it first, to move all possible svcpart-matching
+services)
+
Any services that can't be moved remain in the original package.
Returns an error, if there is one; otherwise, returns the number of services
=cut
sub transfer {
- my ($self, $dest_pkgnum) = @_;
+ my ($self, $dest_pkgnum, %opt) = @_;
my $remaining = 0;
my $dest;
my %target;
- my $pkg_svc;
if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
$dest = $dest_pkgnum;
return ('Package does not exist: '.$dest_pkgnum) unless $dest;
- foreach $pkg_svc (qsearch('pkg_svc', { pkgpart => $dest->pkgpart })) {
+ foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
$target{$pkg_svc->svcpart} = $pkg_svc->quantity;
}
- my $cust_svc;
-
- foreach $cust_svc ($dest->cust_svc) {
+ foreach my $cust_svc ($dest->cust_svc) {
$target{$cust_svc->svcpart}--;
}
- foreach $cust_svc ($self->cust_svc) {
+ my %svcpart2svcparts = ();
+ if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
+ warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
+ foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
+ next if exists $svcpart2svcparts{$svcpart};
+ my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
+ $svcpart2svcparts{$svcpart} = [
+ map { $_->[0] }
+ sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
+ map {
+ my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
+ 'svcpart' => $_ } );
+ [ $_,
+ $pkg_svc ? $pkg_svc->primary_svc : '',
+ $pkg_svc ? $pkg_svc->quantity : 0,
+ ];
+ }
+
+ grep { $_ != $svcpart }
+ map { $_->svcpart }
+ qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
+ ];
+ warn "alternates for svcpart $svcpart: ".
+ join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
+ if $DEBUG;
+ }
+ }
+
+ foreach my $cust_svc ($self->cust_svc) {
if($target{$cust_svc->svcpart} > 0) {
$target{$cust_svc->svcpart}--;
my $new = new FS::cust_svc {
- svcnum => $cust_svc->svcnum,
- svcpart => $cust_svc->svcpart,
- pkgnum => $dest_pkgnum };
+ svcnum => $cust_svc->svcnum,
+ svcpart => $cust_svc->svcpart,
+ pkgnum => $dest_pkgnum,
+ };
my $error = $new->replace($cust_svc);
return $error if $error;
+ } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
+ if ( $DEBUG ) {
+ warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
+ warn "alternates to consider: ".
+ join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
+ }
+ my @alternate = grep {
+ warn "considering alternate svcpart $_: ".
+ "$target{$_} available in new package\n"
+ if $DEBUG;
+ $target{$_} > 0;
+ } @{$svcpart2svcparts{$cust_svc->svcpart}};
+ if ( @alternate ) {
+ warn "alternate(s) found\n" if $DEBUG;
+ my $change_svcpart = $alternate[0];
+ $target{$change_svcpart}--;
+ my $new = new FS::cust_svc {
+ svcnum => $cust_svc->svcnum,
+ svcpart => $change_svcpart,
+ pkgnum => $dest_pkgnum,
+ };
+ my $error = $new->replace($cust_svc);
+ return $error if $error;
+ } else {
+ $remaining++;
+ }
} else {
$remaining++
}
sub order {
my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
+ my $conf = new FS::Conf;
+
# Transactionize this whole mess
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
# Transfer services and cancel old packages.
foreach my $old_pkgnum (@$remove_pkgnum) {
my $old_pkg = qsearchs ('cust_pkg', { pkgnum => $old_pkgnum });
+
foreach my $new_pkg (@$return_cust_pkg) {
$error = $old_pkg->transfer($new_pkg);
if ($error and $error == 0) {
return $error;
}
}
+
+ if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
+ warn "trying transfer again with change_svcpart option\n" if $DEBUG;
+ foreach my $new_pkg (@$return_cust_pkg) {
+ $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
+ if ($error and $error == 0) {
+ # $old_pkg->transfer failed.
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+
if ($error > 0) {
# Transfers were successful, but we went through all of the
# new packages and still had services left on the old package.