FS/FS/cust_main/Merge.pm

   1 package FS::cust_main::Merge;
   2
   3 use strict;
   4 use vars qw( $conf );
   5 use FS::UID qw( dbh );
   6 use FS::Record qw( qsearch qsearchs );
   7 use FS::agent;
   8 use FS::access_user;
   9 use FS::cust_pay_pending;
  10 use FS::cust_tag;
  11 use FS::cust_location;
  12 use FS::contact;
  13 use FS::cust_attachment;
  14 use FS::cust_main_note;
  15 use FS::cust_tax_adjustment;
  16 use FS::cust_pay_batch;
  17 use FS::queue;
  18 use FS::cust_main_exemption;
  19 use FS::cust_main_invoice;
  20
  21 install_callback FS::UID sub {
  22   $conf = new FS::Conf;
  23   #yes, need it for stuff below (prolly should be cached)
  24 };
  25
  26 #old-style merge, new style is with ->attach_pkgs
  27
  28 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
  29
  30 This merges this customer into the provided new custnum, and then deletes the
  31 customer.  If there is an error, returns the error, otherwise returns false.
  32
  33 The source customer's name, company name, phone numbers, agent,
  34 referring customer, customer class, advertising source, order taker, and
  35 billing information (except balance) are discarded.
  36
  37 All packages are moved to the target customer.  Packages with package locations
  38 are preserved.  Packages without package locations are moved to a new package
  39 location with the source customer's service/shipping address.
  40
  41 All invoices, statements, payments, credits and refunds are moved to the target
  42 customer.  The source customer's balance is added to the target customer.
  43
  44 All notes, attachments, tickets and customer tags are moved to the target
  45 customer.
  46
  47 Change history is not currently moved.
  48
  49 =cut
  50
  51 sub merge {
  52   my( $self, $new_custnum, %opt ) = @_;
  53
  54   return "Can't merge a customer into self" if $self->custnum == $new_custnum;
  55
  56   my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
  57     or return "Invalid new customer number: $new_custnum";
  58
  59   return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
  60     if $self->agentnum != $new_cust_main->agentnum
  61     && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
  62
  63   local $SIG{HUP} = 'IGNORE';
  64   local $SIG{INT} = 'IGNORE';
  65   local $SIG{QUIT} = 'IGNORE';
  66   local $SIG{TERM} = 'IGNORE';
  67   local $SIG{TSTP} = 'IGNORE';
  68   local $SIG{PIPE} = 'IGNORE';
  69
  70   my $oldAutoCommit = $FS::UID::AutoCommit;
  71   local $FS::UID::AutoCommit = 0;
  72   my $dbh = dbh;
  73
  74   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
  75      $dbh->rollback if $oldAutoCommit;
  76      return "Can't merge a master agent customer";
  77   }
  78
  79   #use FS::access_user
  80   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
  81      $dbh->rollback if $oldAutoCommit;
  82      return "Can't merge a master employee customer";
  83   }
  84
  85   if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
  86                                      'status'  => { op=>'!=', value=>'done' },
  87                                    }
  88               )
  89   ) {
  90      $dbh->rollback if $oldAutoCommit;
  91      return "Can't merge a customer with pending payments";
  92   }
  93
  94   tie my %financial_tables, 'Tie::IxHash',
  95     'cust_bill'         => 'invoices',
  96     'cust_bill_void'    => 'voided invoices',
  97     'cust_statement'    => 'statements',
  98     'cust_credit'       => 'credits',
  99     'cust_credit_void'  => 'voided credits',
 100     'cust_pay'          => 'payments',
 101     'cust_pay_void'     => 'voided payments',
 102     'cust_refund'       => 'refunds',
 103   ;
 104
 105   foreach my $table ( keys %financial_tables ) {
 106
 107     my @records = $self->$table();
 108
 109     foreach my $record ( @records ) {
 110       $record->custnum($new_custnum);
 111       my $error = $record->replace;
 112       if ( $error ) {
 113         $dbh->rollback if $oldAutoCommit;
 114         return "Error merging ". $financial_tables{$table}. ": $error\n";
 115       }
 116     }
 117
 118   }
 119
 120   my $name = $self->ship_name; #?
 121
 122   my $locationnum = '';
 123   foreach my $cust_pkg ( $self->all_pkgs ) {
 124     $cust_pkg->custnum($new_custnum);
 125
 126     unless ( $cust_pkg->locationnum ) {
 127       unless ( $locationnum ) {
 128         my $cust_location = new FS::cust_location {
 129           $self->location_hash,
 130           'custnum' => $new_custnum,
 131         };
 132         my $error = $cust_location->insert;
 133         if ( $error ) {
 134           $dbh->rollback if $oldAutoCommit;
 135           return $error;
 136         }
 137         $locationnum = $cust_location->locationnum;
 138       }
 139       $cust_pkg->locationnum($locationnum);
 140     }
 141
 142     my $error = $cust_pkg->replace;
 143     if ( $error ) {
 144       $dbh->rollback if $oldAutoCommit;
 145       return $error;
 146     }
 147
 148     # add customer (ship) name to svc_phone.phone_name if blank
 149     my @cust_svc = $cust_pkg->cust_svc;
 150     foreach my $cust_svc (@cust_svc) {
 151       my($label, $value, $svcdb) = $cust_svc->label;
 152       next unless $svcdb eq 'svc_phone';
 153       my $svc_phone = $cust_svc->svc_x;
 154       next if $svc_phone->phone_name;
 155       $svc_phone->phone_name($name);
 156       my $error = $svc_phone->replace;
 157       if ( $error ) {
 158         $dbh->rollback if $oldAutoCommit;
 159         return $error;
 160       }
 161     }
 162
 163   }
 164
 165   #not considered:
 166   # cust_tax_exempt (texas tax exemptions)
 167   # cust_recon (some sort of not-well understood thing for OnPac)
 168
 169   #these are moved over
 170   foreach my $table (qw(
 171     cust_tag cust_location contact cust_attachment cust_main_note
 172     cust_tax_adjustment cust_pay_batch queue
 173   )) {
 174     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
 175       $record->custnum($new_custnum);
 176       my $error = $record->replace;
 177       if ( $error ) {
 178         $dbh->rollback if $oldAutoCommit;
 179         return $error;
 180       }
 181     }
 182   }
 183
 184   #these aren't preserved
 185   foreach my $table (qw(
 186     cust_main_exemption cust_main_invoice
 187   )) {
 188     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
 189       my $error = $record->delete;
 190       if ( $error ) {
 191         $dbh->rollback if $oldAutoCommit;
 192         return $error;
 193       }
 194     }
 195   }
 196
 197
 198   my $sth = $dbh->prepare(
 199     'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
 200   ) or do {
 201     my $errstr = $dbh->errstr;
 202     $dbh->rollback if $oldAutoCommit;
 203     return $errstr;
 204   };
 205   $sth->execute($new_custnum, $self->custnum) or do {
 206     my $errstr = $sth->errstr;
 207     $dbh->rollback if $oldAutoCommit;
 208     return $errstr;
 209   };
 210
 211   #tickets
 212
 213   my $ticket_dbh = '';
 214   if ($conf->config('ticket_system') eq 'RT_Internal') {
 215     $ticket_dbh = $dbh;
 216   } elsif ($conf->config('ticket_system') eq 'RT_External') {
 217     my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
 218     $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
 219       #or die "RT_External DBI->connect error: $DBI::errstr\n";
 220   }
 221
 222   if ( $ticket_dbh ) {
 223
 224     my $ticket_sth = $ticket_dbh->prepare(
 225       'UPDATE Links SET Target = ? WHERE Target = ?'
 226     ) or do {
 227       my $errstr = $ticket_dbh->errstr;
 228       $dbh->rollback if $oldAutoCommit;
 229       return $errstr;
 230     };
 231     $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
 232                          'freeside://freeside/cust_main/'.$self->custnum)
 233       or do {
 234         my $errstr = $ticket_sth->errstr;
 235         $dbh->rollback if $oldAutoCommit;
 236         return $errstr;
 237       };
 238
 239   }
 240
 241   #delete the customer record
 242
 243   my $error = $self->delete;
 244   if ( $error ) {
 245     $dbh->rollback if $oldAutoCommit;
 246     return $error;
 247   }
 248
 249   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 250   '';
 251
 252 }
 253
 254 1;
 255