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 );
@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 ) = @_;
return $error if $error;
my $cust_main = $self->cust_main;
- return "Unknown customer ". $self->custnum unless $cust_main;
+ return "Unknown custnum: ". $self->custnum unless $cust_main;
unless ( $disable_agentcheck ) {
my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } );
$self->otaker($1);
if ( $self->dbdef_table->column('manual_flag') ) {
- $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag";
+ $self->manual_flag('') if $self->manual_flag eq ' ';
+ $self->manual_flag =~ /^([01]?)$/
+ or return "Illegal manual_flag ". $self->manual_flag;
$self->manual_flag($1);
}
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') ) {
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 ) {
: 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<FS::cust_svc>)
+L<FS::cust_svc>). 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<num_avail>, 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
}
-=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<svcnum> (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++
}
return $remaining;
}
+=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
+
+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;
+
+ foreach my $cust_svc ( $self->cust_svc ) {
+ #false laziness w/svc_Common::insert
+ my $svc_x = $cust_svc->svc_x;
+ foreach my $part_export ( $cust_svc->part_svc->part_export ) {
+ my $error = $part_export->export_insert($svc_x);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
=back
=head1 SUBROUTINES
=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;
# 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.
projects / freeside.git / blobdiff