set fixed values from an explicitly specified svcpart on replace too
[freeside.git] / FS / FS / cust_pkg.pm
index b241eca..d2a48e9 100644 (file)
@@ -1,26 +1,42 @@
 package FS::cust_pkg;
 
 use strict;
-use vars qw(@ISA);
+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::cust_svc;
 use FS::part_pkg;
 use FS::cust_main;
 use FS::type_pkgs;
 use FS::pkg_svc;
+use FS::cust_bill_pkg;
 
 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
 # setup }
 # because they load configuraion by setting FS::UID::callback (see TODO)
 use FS::svc_acct;
-use FS::svc_acct_sm;
 use FS::svc_domain;
 use FS::svc_www;
 use FS::svc_forward;
 
+# for sending cancel emails in sub cancel
+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 ) = @_;
@@ -91,7 +107,9 @@ inherits from FS::Record.  The following fields are currently supported:
 
 =item setup - date
 
-=item bill - date
+=item bill - date (next bill date)
+
+=item last_bill - last bill date
 
 =item susp - date
 
@@ -139,7 +157,16 @@ sub insert {
   my $error = $self->ut_number('custnum');
   return $error if $error;
 
-  return "Unknown customer ". $self->custnum unless $self->cust_main;
+  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 };
+  }
 
   $self->SUPER::insert;
 
@@ -219,33 +246,39 @@ sub check {
     return "Unknown customer ". $self->custnum unless $self->cust_main;
   }
 
-  return "Unknown pkgpart"
+  return "Unknown pkgpart: ". $self->pkgpart
     unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
 
   $self->otaker(getotaker) unless $self->otaker;
-  $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker";
+  $self->otaker =~ /^([\w\.\-]{0,16})$/ or return "Illegal otaker";
   $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<FS::cust_svc> and L<FS::part_svc>)
 in this package, then cancels the package itself (sets the cancel field to
 now).
 
+Available options are: I<quiet>
+
+I<quiet> 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';
@@ -259,38 +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 $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
+    push @{ $svc{$cust_svc->part_svc->svcdb} }, $cust_svc;
+  }
 
-    $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
-      $dbh->rollback if $oldAutoCommit;
-      return "Illegal svcdb value in part_svc!";
-    };
-    my $svcdb = $1;
-    require "FS/$svcdb.pm";
+  foreach my $svcdb (@SVCDB_CANCEL_SEQ) {
+    foreach my $cust_svc (@{ $svc{$svcdb} }) {
+      my $error = $cust_svc->cancel;
 
-    my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
-    if ($svc) {
-      $error = $svc->cancel;
       if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return "Error cancelling service: $error" 
+       $dbh->rollback if $oldAutoCommit;
+       return "Error cancelling cust_svc: $error";
       }
-      $error = $svc->delete;
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return "Error deleting service: $error";
-      }
-    }
-
-    $error = $cust_svc->delete;
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "Error deleting cust_svc: $error";
     }
-
   }
 
   unless ( $self->getfield('cancel') ) {
@@ -306,7 +323,21 @@ 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;
+  if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
+    my $conf = new FS::Conf;
+    my $error = send_email(
+      'from'    => $conf->config('invoice_from'),
+      'to'      => \@invoicing_list,
+      'subject' => $conf->config('cancelsubject'),
+      'body'    => [ map "$_\n", $conf->config('cancelmessage') ],
+    );
+    #should this do something on errors?
+  }
+
   ''; #no errors
+
 }
 
 =item suspend
@@ -421,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 ) {
@@ -435,6 +469,24 @@ sub unsuspend {
   ''; #no errors
 }
 
+=item last_bill
+
+Returns the last bill date, or if there is no last bill date, the setup date.
+Useful for billing metered services.
+
+=cut
+
+sub last_bill {
+  my $self = shift;
+  if ( $self->dbdef_table->column('last_bill') ) {
+    return $self->setfield('last_bill', $_[0]) if @_;
+    return $self->getfield('last_bill') if $self->getfield('last_bill');
+  }    
+  my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
+                                                  'edate'  => $self->bill,  } );
+  $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
+}
+
 =item part_pkg
 
 Returns the definition for this billing item, as an FS::part_pkg object (see
@@ -450,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<FS::cust_svc>)
+L<FS::cust_svc>).  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<num_avail>, 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
@@ -492,7 +598,7 @@ sub cust_main {
 =item seconds_since TIMESTAMP
 
 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
-package have been online since TIMESTAMP.
+package have been online since TIMESTAMP, according to the session monitor.
 
 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
 L<Time::Local> and L<Date::Parse> for conversion functions.
@@ -513,6 +619,225 @@ sub seconds_since {
 
 }
 
+=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
+
+Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
+package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
+(exclusive).
+
+TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
+L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
+functions.
+
+
+=cut
+
+sub seconds_since_sqlradacct {
+  my($self, $start, $end) = @_;
+
+  my $seconds = 0;
+
+  foreach my $cust_svc (
+    grep {
+      my $part_svc = $_->part_svc;
+      $part_svc->svcdb eq 'svc_acct'
+        && scalar($part_svc->part_export('sqlradius'));
+    } $self->cust_svc
+  ) {
+    $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
+  }
+
+  $seconds;
+
+}
+
+=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
+
+Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
+in this package for sessions ending between TIMESTAMP_START (inclusive) and
+TIMESTAMP_END
+(exclusive).
+
+TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
+L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
+functions.
+
+=cut
+
+sub attribute_since_sqlradacct {
+  my($self, $start, $end, $attrib) = @_;
+
+  my $sum = 0;
+
+  foreach my $cust_svc (
+    grep {
+      my $part_svc = $_->part_svc;
+      $part_svc->svcdb eq 'svc_acct'
+        && scalar($part_svc->part_export('sqlradius'));
+    } $self->cust_svc
+  ) {
+    $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
+  }
+
+  $sum;
+
+}
+
+=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;
+}
+
+=item reexport
+
+This method is deprecated.  See the I<depend_jobnum> 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
@@ -539,61 +864,11 @@ newly-created cust_pkg objects.
 =cut
 
 sub order {
-  my($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_;
-  $remove_pkgnums = [] unless defined($remove_pkgnums);
+  my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
 
-  my $oldAutoCommit = $FS::UID::AutoCommit;
-  local $FS::UID::AutoCommit = 0;
-  my $dbh = dbh;
+  my $conf = new FS::Conf;
 
-  # generate %part_pkg
-  # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
-  #
-  my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
-  my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
-  my %part_pkg = %{ $agent->pkgpart_hashref };
-
-  my(%svcnum);
-  # generate %svcnum
-  # for those packages being removed:
-  #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::Record
-  # objects (table eq 'cust_svc')
-  my($pkgnum);
-  foreach $pkgnum ( @{$remove_pkgnums} ) {
-    my($cust_svc);
-    foreach $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
-      push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
-    }
-  }
-  
-  my(@cust_svc);
-  #generate @cust_svc
-  # for those packages the customer is purchasing:
-  # @{$pkgparts} is a list of said packages, by pkgpart
-  # @cust_svc is a corresponding list of lists of FS::Record objects
-  my($pkgpart);
-  foreach $pkgpart ( @{$pkgparts} ) {
-    unless ( $part_pkg{$pkgpart} ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "Customer not permitted to purchase pkgpart $pkgpart!";
-    }
-    push @cust_svc, [
-      map {
-        ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
-      } map { $_->svcpart } qsearch('pkg_svc', { 'pkgpart' => $pkgpart })
-    ];
-  }
-
-  #check for leftover services
-  foreach (keys %svcnum) {
-    next unless @{ $svcnum{$_} };
-    $dbh->rollback if $oldAutoCommit;
-    return "Leftover services, svcpart $_: svcnum ".
-           join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
-  }
-
-  #no leftover services, let's make changes.
+  # Transactionize this whole mess
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE'; 
   local $SIG{QUIT} = 'IGNORE';
@@ -601,63 +876,73 @@ sub order {
   local $SIG{TSTP} = 'IGNORE'; 
   local $SIG{PIPE} = 'IGNORE'; 
 
-  #first cancel old packages
-#  my($pkgnum);
-  foreach $pkgnum ( @{$remove_pkgnums} ) {
-    my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-    unless ( $old ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "Package $pkgnum not found to remove!";
-    }
-    my(%hash) = $old->hash;
-    $hash{'cancel'}=time;   
-    my($new) = new FS::cust_pkg ( \%hash );
-    my($error)=$new->replace($old);
-    if ( $error ) {
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error;
+  my $cust_main = qsearchs('cust_main', { custnum => $custnum });
+  return "Customer not found: $custnum" unless $cust_main;
+
+  # Create the new packages.
+  my $cust_pkg;
+  foreach (@$pkgparts) {
+    $cust_pkg = new FS::cust_pkg { custnum => $custnum,
+                                   pkgpart => $_ };
+    $error = $cust_pkg->insert;
+    if ($error) {
       $dbh->rollback if $oldAutoCommit;
-      return "Couldn't update package $pkgnum: $error";
+      return $error;
     }
+    push @$return_cust_pkg, $cust_pkg;
   }
-
-  #now add new packages, changing cust_svc records if necessary
-#  my($pkgpart);
-  while ($pkgpart=shift @{$pkgparts} ) {
-    my $new = new FS::cust_pkg {
-                                 'custnum' => $custnum,
-                                 'pkgpart' => $pkgpart,
-                               };
-    my $error = $new->insert;
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "Couldn't insert new cust_pkg record: $error";
+  # $return_cust_pkg now contains refs to all of the newly 
+  # 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 $new_pkg (@$return_cust_pkg) {
+      $error = $old_pkg->transfer($new_pkg);
+      if ($error and $error == 0) {
+        # $old_pkg->transfer failed.
+       $dbh->rollback if $oldAutoCommit;
+       return $error;
+      }
     }
-    push @{$return_cust_pkg}, $new if $return_cust_pkg;
-    my $pkgnum = $new->pkgnum;
-    foreach my $cust_svc ( @{ shift @cust_svc } ) {
-      my(%hash) = $cust_svc->hash;
-      $hash{'pkgnum'}=$pkgnum;
-      my($new) = new FS::cust_svc ( \%hash );
-      my($error)=$new->replace($cust_svc);
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return "Couldn't link old service to new package: $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.
+      # We can't cancel the package under the circumstances, so abort.
+      $dbh->rollback if $oldAutoCommit;
+      return "Unable to transfer all services from package ".$old_pkg->pkgnum;
+    }
+    $error = $old_pkg->cancel;
+    if ($error) {
+      $dbh->rollback;
+      return $error;
+    }
+  }
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
-  ''; #no errors
+  '';
 }
 
 =back
 
-=head1 VERSION
-
-$Id: cust_pkg.pm,v 1.16 2002-01-29 16:33:15 ivan Exp $
-
 =head1 BUGS
 
 sub order is not OO.  Perhaps it should be moved to FS::cust_main and made so?
@@ -667,11 +952,12 @@ In sub order, the @pkgparts array (passed by reference) is clobbered.
 Also in sub order, no money is adjusted.  Once FS::part_pkg defines a standard
 method to pass dates to the recur_prog expression, it should do so.
 
-FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at 
-compile time, rather than via 'require' in sub { setup, suspend, unsuspend,
-cancel } because they use %FS::UID::callback to load configuration values.
-Probably need a subroutine which decides what to do based on whether or not
-we've fetched the user yet, rather than a hash.  See FS::UID and the TODO.
+FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
+loaded via 'use' at compile time, rather than via 'require' in sub { setup,
+suspend, unsuspend, cancel } because they use %FS::UID::callback to load
+configuration values.  Probably need a subroutine which decides what to do
+based on whether or not we've fetched the user yet, rather than a hash.  See
+FS::UID and the TODO.
 
 Now that things are transactional should the check in the insert method be
 moved to check ?