X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=d2a48e9f75cffbf549ced7383d9ca63671736d9c;hp=5700b654e7733abf86122cd97361d65bc979392e;hb=101cc49024f693a837e2ff74a89a300b7ecb8976;hpb=b16fc4133f24d3844755fe45243e437c9c35769d diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 5700b654e..d2a48e9f7 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,7 +1,7 @@ package FS::cust_pkg; use strict; -use vars qw(@ISA $disable_agentcheck); +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 ); @@ -25,8 +25,18 @@ use FS::Conf; @ISA = qw( FS::Record ); +$DEBUG = 0; + $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 ) = @_; @@ -282,16 +292,22 @@ sub cancel { 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') ) { @@ -436,7 +452,10 @@ sub unsuspend { unless ( ! $self->getfield('susp') ) { my %hash = $self->hash; + my $inactive = time - $hash{'susp'}; $hash{'susp'} = ''; + $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive + if $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} ); my $new = new FS::cust_pkg ( \%hash ); $error = $new->replace($self); if ( $error ) { @@ -483,20 +502,74 @@ sub part_pkg { : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); } -=item cust_svc +=item cust_svc [ SVCPART ] Returns the services for this package, as FS::cust_svc objects (see -L) +L). If a svcpart is specified, return only the matching +services. =cut sub cust_svc { my $self = shift; - if ( $self->{'_svcnum'} ) { - values %{ $self->{'_svcnum'}->cache }; - } else { - qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } ); + + if ( @_ ) { + return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum, + 'svcpart' => shift, } ); } + + #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 num_cust_svc [ SVCPART ] + +Returns the number of provisioned services for this package. If a svcpart is +specified, counts only the matching services. + +=cut + +sub num_cust_svc { + my $self = shift; + my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?'; + $sql .= ' AND svcpart = ?' if @_; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute($self->pkgnum, @_) or die $sth->errstr; + $sth->fetchrow_arrayref->[0]; +} + +=item available_part_svc + +Returns a list FS::part_svc objects representing services included in this +package but not yet provisioned. Each FS::part_svc object also has an extra +field, I, which specifies the number of available services. + +=cut + +sub available_part_svc { + my $self = shift; + grep { $_->num_avail > 0 } + map { + my $part_svc = $_->part_svc; + $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking + $_->quantity - $self->num_cust_svc($_->svcpart); + $part_svc; + } + $self->part_pkg->pkg_svc; } =item labels @@ -610,11 +683,21 @@ sub attribute_since_sqlradacct { } -=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 (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 (not svcdb), unless the B 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 @@ -623,12 +706,11 @@ that couldn't be moved. =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; @@ -639,25 +721,78 @@ sub transfer { 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++ } @@ -667,6 +802,9 @@ sub transfer { =item reexport +This method is deprecated. See the I option to the insert and +order_pkgs methods in FS::cust_main for a better way to defer provisioning. + =cut sub reexport { @@ -726,13 +864,18 @@ newly-created cust_pkg objects. =cut sub order { - - # Rewritten to make use of the transfer() method, and in general - # to not suck so badly. - 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'; + 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; @@ -759,6 +902,7 @@ sub order { # 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) { @@ -767,6 +911,19 @@ sub order { 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.