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