4 files changed, 110 insertions, 2 deletions

diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm
index bfb39b4ad..373617e36 100644
--- a/FS/FS/AccessRight.pm
+++ b/FS/FS/AccessRight.pm
@@ -132,6 +132,7 @@ tie my %rights, 'Tie::IxHash',
     'Order customer package',
     'One-time charge',
     'Change customer package',
+    'Detach customer package',
     'Bulk change customer packages',
     'Edit customer package dates',
     'Discount customer package', #NEW
diff --git a/FS/FS/access_right.pm b/FS/FS/access_right.pm
index d370ba5d1..5bcf92214 100644
--- a/FS/FS/access_right.pm
+++ b/FS/FS/access_right.pm
@@ -232,6 +232,7 @@ sub _upgrade_data { # class method
     'Financial reports' => [ 'Employees: Commission Report',
                              'Employees: Audit Report',
                            ],
+    'Change customer package' => 'Detach customer package',
 ;
 
   foreach my $old_acl ( keys %onetime ) {
diff --git a/FS/FS/cust_main/Packages.pm b/FS/FS/cust_main/Packages.pm
index f83bce915..41ef22894 100644
--- a/FS/FS/cust_main/Packages.pm
+++ b/FS/FS/cust_main/Packages.pm
@@ -4,9 +4,11 @@ use strict;
 use vars qw( $DEBUG $me );
 use List::Util qw( min );
 use FS::UID qw( dbh );
-use FS::Record qw( qsearch );
+use FS::Record qw( qsearch qsearchs );
 use FS::cust_pkg;
 use FS::cust_svc;
+use FS::contact;       # for attach_pkgs
+use FS::cust_location; #
 
 $DEBUG = 0;
 $me = '[FS::cust_main::Packages]';
@@ -291,6 +293,108 @@ sub order_pkgs {
   ''; #no error
 }
 
+=item attach_pkgs 
+
+Merges this customer's package's into the target customer and then cancels them.
+
+=cut
+
+sub attach_pkgs {
+  my( $self, $new_custnum ) = @_;
+
+  #mostly false laziness w/ merge
+
+  return "Can't attach packages to self" if $self->custnum == $new_custnum;
+
+  my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
+    or return "Invalid new customer number: $new_custnum";
+
+  return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
+    if $self->agentnum != $new_cust_main->agentnum 
+    && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
+
+  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;
+
+  if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
+     $dbh->rollback if $oldAutoCommit;
+     return "Can't merge a master agent customer";
+  }
+
+  #use FS::access_user
+  if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
+     $dbh->rollback if $oldAutoCommit;
+     return "Can't merge a master employee customer";
+  }
+
+  if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
+                                     'status'  => { op=>'!=', value=>'done' },
+                                   }
+              )
+  ) {
+     $dbh->rollback if $oldAutoCommit;
+     return "Can't merge a customer with pending payments";
+  }
+
+  #end of false laziness
+
+  #pull in contact
+
+  my %contact_hash = ( 'first'    => $self->first,
+                       'last'     => $self->get('last'),
+                       'custnum'  => $new_custnum,
+                       'disabled' => '',
+                     );
+
+  my $contact = qsearchs(  'contact', \%contact_hash)
+                 || new FS::contact   \%contact_hash;
+  unless ( $contact->contactnum ) {
+    my $error = $contact->insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
+
+    my $cust_location = $cust_pkg->cust_location || $self->ship_location;
+    my %loc_hash = $cust_location->hash;
+    $loc_hash{'locationnum'} = '';
+    $loc_hash{'custnum'}     = $new_custnum;
+    $loc_hash{'disabled'}    = '';
+    my $new_cust_location = qsearchs(  'cust_location', \%loc_hash)
+                             || new FS::cust_location   \%loc_hash;
+
+    my $pkg_or_error = $cust_pkg->change( {
+      'keep_dates'    => 1,
+      'cust_main'     => $new_cust_main,
+      'contactnum'    => $contact->contactnum,
+      'cust_location' => $new_cust_location,
+    } );
+
+    my $error = ref($pkg_or_error) ? '' : $pkg_or_error;
+
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  ''; #no error
+
+}
+
 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
 
 Returns all packages (see L<FS::cust_pkg>) for this customer.
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index d8b6e699e..4464aa5a2 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -1827,7 +1827,7 @@ sub change {
   my $custnum = $self->custnum;
   if ( $opt->{cust_main} ) {
     my $cust_main = $opt->{cust_main};
-    unless ( $cust_main->custnum) { 
+    unless ( $cust_main->custnum ) { 
       my $error = $cust_main->insert;
       if ( $error ) {
         $dbh->rollback if $oldAutoCommit;
@@ -1837,6 +1837,8 @@ sub change {
     $custnum = $cust_main->custnum;
   }
 
+  $hash{'contactnum'} = $opt->{'contactnum'} if $opt->{'contactnum'};
+
   # Create the new package.
   my $cust_pkg = new FS::cust_pkg {
     custnum        => $custnum,