X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=d2a48e9f75cffbf549ced7383d9ca63671736d9c;hp=a423c551819c7994790cffcf755a06d356f5338e;hb=101cc49024f693a837e2ff74a89a300b7ecb8976;hpb=c0567c688084e89fcd11bf82348b6c418f1254ac diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index a423c5518..d2a48e9f7 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,8 +1,7 @@ package FS::cust_pkg; use strict; -use vars qw(@ISA $disable_agentcheck); -use vars qw( $quiet ); +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 ); @@ -26,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 ) = @_; @@ -149,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 } ); @@ -245,25 +254,31 @@ 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); } - ''; #no error + $self->SUPER::check; } -=item cancel +=item cancel [ OPTION => VALUE ... ] Cancels and removes all services (see L and L) in this package, then cancels the package itself (sets the cancel field to now). +Available options are: I + +I can be set true to supress email cancellation notices. + If there is an error, returns the error, otherwise returns false. =cut sub cancel { - my $self = shift; + my( $self, %options ) = @_; my $error; local $SIG{HUP} = 'IGNORE'; @@ -277,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') ) { @@ -304,7 +325,7 @@ sub cancel { my $conf = new FS::Conf; my @invoicing_list = grep { $_ ne 'POST' } $self->cust_main->invoicing_list; - if ( !$quiet && $conf->exists('emailcancel') && @invoicing_list ) { + if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) { my $conf = new FS::Conf; my $error = send_email( 'from' => $conf->config('invoice_from'), @@ -431,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 ) { @@ -478,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 @@ -605,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 @@ -618,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; @@ -634,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++ } @@ -660,6 +800,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 @@ -686,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; @@ -719,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) { @@ -727,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.