X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=d554d8be79ba7aeb4822f104dcc6d487d5e0b5ac;hp=9a54b95c9ca30289787c0f61ded84d2829a9aa79;hb=cbbc7e215fb2f235c05abdb8c9434bdb2385ce3f;hpb=a39d4a1fccda8c95157c6667c66b22b75b4f1e03 diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 9a54b95c9..d554d8be7 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 ) = @_; @@ -148,7 +158,7 @@ sub insert { 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 } ); @@ -244,7 +254,9 @@ sub check { $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); } @@ -280,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') ) { @@ -608,11 +626,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 @@ -621,7 +649,7 @@ that couldn't be moved. =cut sub transfer { - my ($self, $dest_pkgnum) = @_; + my ($self, $dest_pkgnum, %opt) = @_; my $remaining = 0; my $dest; @@ -647,15 +675,59 @@ sub transfer { $target{$cust_svc->svcpart}--; } + 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} = [ + grep { $_ != $svcpart } + map { $_->svcpart } + qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } ) + ]; + warn "alternates for svcpart $svcpart: ". + join(', ', @{$svcpart2svcparts{$svcpart}}). "\n" + if $DEBUG; + } + } + foreach $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]; #arbitrary. + $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++ } @@ -663,6 +735,44 @@ sub transfer { return $remaining; } +=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 { + 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 @@ -689,13 +799,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; @@ -722,6 +837,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) { @@ -730,6 +846,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.