X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=fdb62619d3515e76d1eebb7391adb2fee8327a53;hp=f54b42d7e8dcc3341597f3d3641ed20c8c5bc41b;hb=fb617bff98dd66b665d28c9c1481ec84ee095dc3;hpb=e6163f4fbcde29824afc6166ca63b1d946d2a0df diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index f54b42d7e..fdb62619d 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -4432,24 +4432,42 @@ sub transfer { my $error; foreach my $cust_svc ($self->cust_svc) { my $svcnum = $cust_svc->svcnum; - if($target{$cust_svc->svcpart} > 0 - or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option + + if ( $target{$cust_svc->svcpart} > 0 + or $FS::cust_svc::ignore_quantity # maybe should be a 'force' option + ) + { $target{$cust_svc->svcpart}--; + + local $FS::cust_svc::ignore_quantity = 1 + if $self->pkgnum == $dest->pkgnum; + + #why run replace at all in the $self->pkgnum == $dest->pkgnum case? + # we do want to trigger location and pkg_change exports, but + # without pkgnum changing from an old to new package, cust_svc->replace + # doesn't know how to trigger those. :/ + # does this mean we scrap the whole idea of "safe to modify it in place", + # or do we special-case and pass the info needed to cust_svc->replace? :/ + my $new = new FS::cust_svc { $cust_svc->hash }; $new->pkgnum($dest_pkgnum); $error = $new->replace($cust_svc); + } 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]; @@ -4461,13 +4479,16 @@ sub transfer { } else { $remaining++; } + } else { $remaining++ } + if ( $error ) { my @label = $cust_svc->label; return "$label[0] $label[1]: $error"; } + } return $remaining; }