X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=783cc73a3ebb715a0a6987aa0efbb53e6f298581;hb=fadaa67e77ad8d5d966e252aba7f193e9e3840e3;hp=ccd73acc8dc419bc8e013217caf87a20950e79b7;hpb=6af03ca1ad3c06aa1e7affb634bb0640b139dd6d;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index ccd73acc8..783cc73a3 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -3,18 +3,21 @@ package FS::cust_pkg; use strict; 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 ); +use FS::Record qw( qsearch qsearchs ); +use FS::cust_main_Mixin; use FS::cust_svc; use FS::part_pkg; use FS::cust_main; use FS::type_pkgs; use FS::pkg_svc; use FS::cust_bill_pkg; +use FS::h_cust_svc; +use FS::reg_code; # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, # setup } -# because they load configuraion by setting FS::UID::callback (see TODO) +# because they load configuration by setting FS::UID::callback (see TODO) use FS::svc_acct; use FS::svc_domain; use FS::svc_www; @@ -23,7 +26,7 @@ use FS::svc_forward; # for sending cancel emails in sub cancel use FS::Conf; -@ISA = qw( FS::Record ); +@ISA = qw( FS::cust_main_Mixin FS::Record ); $DEBUG = 0; @@ -139,36 +142,95 @@ Create a new billing item. To add the item to the database, see L<"insert">. =cut sub table { 'cust_pkg'; } +sub cust_linked { $_[0]->cust_main_custnum; } +sub cust_unlinked_msg { + my $self = shift; + "WARNING: can't find cust_main.custnum ". $self->custnum. + ' (cust_pkg.pkgnum '. $self->pkgnum. ')'; +} -=item insert +=item insert [ OPTION => VALUE ... ] Adds this billing item to the database ("Orders" the item). If there is an error, returns the error, otherwise returns false. +If the additional field I is defined instead of I, it +will be used to look up the package definition and agent restrictions will be +ignored. + +The following options are available: I + +I, if set true, supresses any referral credit to a referring customer. + =cut sub insert { - my $self = shift; + my( $self, %options ) = @_; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; - # custnum might not have have been defined in sub check (for one-shot new - # customers), so check it here instead - # (is this still necessary with transactions?) + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; - my $error = $self->ut_number('custnum'); - return $error if $error; + my $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + #if ( $self->reg_code ) { + # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } ); + # $error = $reg_code->delete; + # if ( $error ) { + # $dbh->rollback if $oldAutoCommit; + # return $error; + # } + #} + + my $conf = new FS::Conf; my $cust_main = $self->cust_main; - return "Unknown custnum: ". $self->custnum unless $cust_main; - - unless ( $disable_agentcheck ) { - my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } ); - my $pkgpart_href = $agent->pkgpart_hashref; - return "agent ". $agent->agentnum. - " can't purchase pkgpart ". $self->pkgpart - unless $pkgpart_href->{ $self->pkgpart }; + my $part_pkg = $self->part_pkg; + if ( $conf->exists('referral_credit') + && $cust_main->referral_custnum + && ! $options{'change'} + && $part_pkg->freq !~ /^0\D?$/ + ) + { + my $referring_cust_main = $cust_main->referring_cust_main; + if ( $referring_cust_main->status ne 'cancelled' ) { + my $error; + if ( $part_pkg->freq !~ /^\d+$/ ) { + warn 'WARNING: Not crediting customer '. $cust_main->referral_custnum. + ' for package '. $self->pkgnum. + ' ( customer '. $self->custnum. ')'. + ' - One-time referral credits not (yet) available for '. + ' packages with '. $part_pkg->freq_pretty. ' frequency'; + } else { + + my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq ); + my $error = + $referring_cust_main->credit( $amount, + 'Referral credit for '. $cust_main->name + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error crediting customer ". $cust_main->referral_custnum. + " for referral: $error"; + } + + } + + } } - $self->SUPER::insert; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; } @@ -202,6 +264,8 @@ suspend is normally updated by the suspend and unsuspend methods. cancel is normally updated by the cancel method (and also the order subroutine in some cases). +Calls + =cut sub replace { @@ -217,7 +281,53 @@ sub replace { #some logic for bill, susp, cancel? - $new->SUPER::replace($old); + local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart; + + 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; + + #save off and freeze RADIUS attributes for any associated svc_acct records + my @svc_acct = (); + if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) { + + #also check for specific exports? + # to avoid spurious modify export events + @svc_acct = map { $_->svc_x } + grep { $_->part_svc->svcdb eq 'svc_acct' } + $old->cust_svc; + + $_->snapshot foreach @svc_acct; + + } + + my $error = $new->SUPER::replace($old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + #for prepaid packages, + #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes + foreach my $old_svc_acct ( @svc_acct ) { + my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash }; + my $s_error = $new_svc_acct->replace($old_svc_acct); + if ( $s_error ) { + $dbh->rollback if $oldAutoCommit; + return $s_error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + } =item check @@ -233,8 +343,8 @@ sub check { my $error = $self->ut_numbern('pkgnum') - || $self->ut_numbern('custnum') - || $self->ut_number('pkgpart') + || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') + || $self->ut_numbern('pkgpart') || $self->ut_numbern('setup') || $self->ut_numbern('bill') || $self->ut_numbern('susp') @@ -242,12 +352,40 @@ sub check { ; return $error if $error; - if ( $self->custnum ) { - return "Unknown customer ". $self->custnum unless $self->cust_main; - } + if ( $self->reg_code ) { + + unless ( grep { $self->pkgpart == $_->pkgpart } + map { $_->reg_code_pkg } + qsearchs( 'reg_code', { 'code' => $self->reg_code, + 'agentnum' => $self->cust_main->agentnum }) + ) { + return "Unknown registration code"; + } + + } elsif ( $self->promo_code ) { + + my $promo_part_pkg = + qsearchs('part_pkg', { + 'pkgpart' => $self->pkgpart, + 'promo_code' => { op=>'ILIKE', value=>$self->promo_code }, + } ); + return 'Unknown promotional code' unless $promo_part_pkg; + + } else { - return "Unknown pkgpart: ". $self->pkgpart - unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); + unless ( $disable_agentcheck ) { + my $agent = + qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } ); + my $pkgpart_href = $agent->pkgpart_hashref; + return "agent ". $agent->agentnum. + " can't purchase pkgpart ". $self->pkgpart + unless $pkgpart_href->{ $self->pkgpart }; + } + + $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' ); + return $error if $error; + + } $self->otaker(getotaker) unless $self->otaker; $self->otaker =~ /^([\w\.\-]{0,16})$/ or return "Illegal otaker"; @@ -310,6 +448,20 @@ sub cancel { } } + # Add a credit for remaining service + my $remaining_value = $self->calc_remain(); + if ( $remaining_value > 0 ) { + my $error = $self->cust_main->credit( + $remaining_value, + 'Credit for unused time on '. $self->part_pkg->pkg, + ); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return "Error crediting customer \$$remaining_value for unused time on". + $self->part_pkg->pkg. ": $error"; + } + } + unless ( $self->getfield('cancel') ) { my %hash = $self->hash; $hash{'cancel'} = time; @@ -324,7 +476,7 @@ sub cancel { $dbh->commit or die $dbh->errstr if $oldAutoCommit; my $conf = new FS::Conf; - my @invoicing_list = grep { $_ ne 'POST' } $self->cust_main->invoicing_list; + my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list; if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) { my $conf = new FS::Conf; my $error = send_email( @@ -452,7 +604,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 ) { @@ -499,20 +654,199 @@ sub part_pkg { : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); } -=item cust_svc +=item calc_setup + +Calls the I of the FS::part_pkg object associated with this billing +item. + +=cut + +sub calc_setup { + my $self = shift; + $self->part_pkg->calc_setup($self, @_); +} + +=item calc_recur + +Calls the I of the FS::part_pkg object associated with this billing +item. + +=cut + +sub calc_recur { + my $self = shift; + $self->part_pkg->calc_recur($self, @_); +} + +=item calc_remain + +Calls the I of the FS::part_pkg object associated with this +billing item. + +=cut + +sub calc_remain { + my $self = shift; + $self->part_pkg->calc_remain($self, @_); +} + +=item calc_cancel + +Calls the I of the FS::part_pkg object associated with this +billing item. + +=cut + +sub calc_cancel { + my $self = shift; + $self->part_pkg->calc_cancel($self, @_); +} + +=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 { + $self->_sort_cust_svc( + [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ] + ); + #} + +} + +=item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] + +Returns historical services for this package created before END TIMESTAMP and +(optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects +(see L). + +=cut + +sub h_cust_svc { + my $self = shift; + + $self->_sort_cust_svc( + [ qsearch( 'h_cust_svc', + { 'pkgnum' => $self->pkgnum, }, + FS::h_cust_svc->sql_h_search(@_), + ) + ] + ); +} + +sub _sort_cust_svc { + my( $self, $arrayref ) = @_; + + 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, + ]; + } + @$arrayref; + +} + +=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 status + +Returns a short status string for this package, currently: + +=over 4 + +=item not yet billed + +=item one-time charge + +=item active + +=item suspended + +=item cancelled + +=back + +=cut + +sub status { + my $self = shift; + + return 'cancelled' if $self->get('cancel'); + return 'suspended' if $self->susp; + return 'not yet billed' unless $self->setup; + return 'one-time charge' if $self->part_pkg->freq =~ /^(0|$)/; + return 'active'; +} + +=item statuscolor + +Returns a hex triplet color string for this package's status. + +=cut + +my %statuscolor = ( + 'not yet billed' => '000000', + 'one-time charge' => '000000', + 'active' => '00CC00', + 'suspended' => 'FF9900', + 'cancelled' => 'FF0000', +); +sub statuscolor { + my $self = shift; + $statuscolor{$self->status}; } =item labels @@ -527,6 +861,52 @@ sub labels { map { [ $_->label ] } $self->cust_svc; } +=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] + +Like the labels method, but returns historical information on services that +were active as of END_TIMESTAMP and (optionally) not cancelled before +START_TIMESTAMP. + +Returns a list of lists, calling the label method for all (historical) services +(see L) of this billing item. + +=cut + +sub h_labels { + my $self = shift; + map { [ $_->label(@_) ] } $self->h_cust_svc(@_); +} + +=item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ] + +Like h_labels, except returns a simple flat list, and shortens long +(currently >5) lists of identical services to one line that lists the service +label and the number of individual services rather than individual items. + +=cut + +sub h_labels_short { + my $self = shift; + + my %labels; + #tie %labels, 'Tie::IxHash'; + push @{ $labels{$_->[0]} }, $_->[1] + foreach $self->h_labels(@_); + my @labels; + foreach my $label ( keys %labels ) { + my @values = @{ $labels{$label} }; + my $num = scalar(@values); + if ( $num > 5 ) { + push @labels, "$label ($num)"; + } else { + push @labels, map { "$label: $_" } @values; + } + } + + @labels; + +} + =item cust_main Returns the parent customer object (see L). @@ -626,11 +1006,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 @@ -639,12 +1029,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; @@ -655,25 +1044,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++ } @@ -721,6 +1163,60 @@ sub reexport { =back +=head1 CLASS METHOD + +=over 4 + +=item recurring_sql + +Returns an SQL expression identifying recurring packages. + +=cut + +sub recurring_sql { " + '0' != ( select freq from part_pkg + where cust_pkg.pkgpart = part_pkg.pkgpart ) +"; } + +=item active_sql + +Returns an SQL expression identifying active packages. + +=cut + +sub active_sql { " + ". $_[0]->recurring_sql(). " + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) +"; } + +=item susp_sql +=item suspended_sql + +Returns an SQL expression identifying suspended packages. + +=cut + +sub suspended_sql { susp_sql(@_); } +sub susp_sql { " + ". $_[0]->recurring_sql(). " + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 +"; } + +=item cancel_sql +=item cancelled_sql + +Returns an SQL exprression identifying cancelled packages. + +=cut + +sub cancelled_sql { cancel_sql(@_); } +sub cancel_sql { " + ". $_[0]->recurring_sql(). " + AND cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0 +"; } + =head1 SUBROUTINES =over 4 @@ -747,6 +1243,8 @@ newly-created cust_pkg objects. 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'; @@ -763,12 +1261,24 @@ sub order { my $cust_main = qsearchs('cust_main', { custnum => $custnum }); return "Customer not found: $custnum" unless $cust_main; + my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) } + @$remove_pkgnum; + + my $change = scalar(@old_cust_pkg) != 0; + + my %hash = (); + if ( scalar(@old_cust_pkg) == 1 ) { + #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill ); + $hash{'setup'} = time; + } + # Create the new packages. - my $cust_pkg; - foreach (@$pkgparts) { - $cust_pkg = new FS::cust_pkg { custnum => $custnum, - pkgpart => $_ }; - $error = $cust_pkg->insert; + foreach my $pkgpart (@$pkgparts) { + my $cust_pkg = new FS::cust_pkg { custnum => $custnum, + pkgpart => $pkgpart, + %hash, + }; + $error = $cust_pkg->insert( 'change' => $change ); if ($error) { $dbh->rollback if $oldAutoCommit; return $error; @@ -779,8 +1289,8 @@ sub order { # created packages. # Transfer services and cancel old packages. - foreach my $old_pkgnum (@$remove_pkgnum) { - my $old_pkg = qsearchs ('cust_pkg', { pkgnum => $old_pkgnum }); + foreach my $old_pkg (@old_cust_pkg) { + foreach my $new_pkg (@$return_cust_pkg) { $error = $old_pkg->transfer($new_pkg); if ($error and $error == 0) { @@ -789,6 +1299,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.