-=item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
-
-Transfers as many services as possible from this package to another package.
-
-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
-that couldn't be moved.
-
-=cut
-
-sub transfer {
- my ($self, $dest_pkgnum, %opt) = @_;
-
- my $remaining = 0;
- my $dest;
- my %target;
-
- if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
- $dest = $dest_pkgnum;
- $dest_pkgnum = $dest->pkgnum;
- } else {
- $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
- }
-
- return ('Package does not exist: '.$dest_pkgnum) unless $dest;
-
- foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
- $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
- }
-
- foreach my $cust_svc ($dest->cust_svc) {
- $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} = [
- 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,
- };
- 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;
-}
-