1 package FS::cust_main::Merge;
6 use FS::Record qw( qsearch qsearchs );
9 use FS::cust_pay_pending;
11 use FS::cust_location;
13 use FS::cust_attachment;
14 use FS::cust_main_note;
15 use FS::cust_tax_adjustment;
16 use FS::cust_pay_batch;
18 use FS::cust_main_exemption;
19 use FS::cust_main_invoice;
21 install_callback FS::UID sub {
23 #yes, need it for stuff below (prolly should be cached)
26 #old-style merge, new style is with ->attach_pkgs
28 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
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.
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.
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.
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.
44 All notes, attachments, tickets and customer tags are moved to the target
47 Change history is not currently moved.
52 my( $self, $new_custnum, %opt ) = @_;
54 return "Can't merge a customer into self" if $self->custnum == $new_custnum;
56 my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
57 or return "Invalid new customer number: $new_custnum";
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');
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';
70 my $oldAutoCommit = $FS::UID::AutoCommit;
71 local $FS::UID::AutoCommit = 0;
74 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
75 $dbh->rollback if $oldAutoCommit;
76 return "Can't merge a master agent customer";
80 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
81 $dbh->rollback if $oldAutoCommit;
82 return "Can't merge a master employee customer";
85 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
86 'status' => { op=>'!=', value=>'done' },
90 $dbh->rollback if $oldAutoCommit;
91 return "Can't merge a customer with pending payments";
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',
105 foreach my $table ( keys %financial_tables ) {
107 my @records = $self->$table();
109 foreach my $record ( @records ) {
110 $record->custnum($new_custnum);
111 my $error = $record->replace;
113 $dbh->rollback if $oldAutoCommit;
114 return "Error merging ". $financial_tables{$table}. ": $error\n";
120 my $name = $self->ship_name; #?
122 my $locationnum = '';
123 foreach my $cust_pkg ( $self->all_pkgs ) {
124 $cust_pkg->custnum($new_custnum);
126 unless ( $cust_pkg->locationnum ) {
127 unless ( $locationnum ) {
128 my $cust_location = new FS::cust_location {
129 $self->location_hash,
130 'custnum' => $new_custnum,
132 my $error = $cust_location->insert;
134 $dbh->rollback if $oldAutoCommit;
137 $locationnum = $cust_location->locationnum;
139 $cust_pkg->locationnum($locationnum);
142 my $error = $cust_pkg->replace;
144 $dbh->rollback if $oldAutoCommit;
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;
158 $dbh->rollback if $oldAutoCommit;
166 # cust_tax_exempt (texas tax exemptions)
167 # cust_recon (some sort of not-well understood thing for OnPac)
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
174 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
175 $record->custnum($new_custnum);
176 my $error = $record->replace;
178 $dbh->rollback if $oldAutoCommit;
184 #these aren't preserved
185 foreach my $table (qw(
186 cust_main_exemption cust_main_invoice
188 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
189 my $error = $record->delete;
191 $dbh->rollback if $oldAutoCommit;
198 my $sth = $dbh->prepare(
199 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
201 my $errstr = $dbh->errstr;
202 $dbh->rollback if $oldAutoCommit;
205 $sth->execute($new_custnum, $self->custnum) or do {
206 my $errstr = $sth->errstr;
207 $dbh->rollback if $oldAutoCommit;
214 if ($conf->config('ticket_system') eq 'RT_Internal') {
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";
224 my $ticket_sth = $ticket_dbh->prepare(
225 'UPDATE Links SET Target = ? WHERE Target = ?'
227 my $errstr = $ticket_dbh->errstr;
228 $dbh->rollback if $oldAutoCommit;
231 $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
232 'freeside://freeside/cust_main/'.$self->custnum)
234 my $errstr = $ticket_sth->errstr;
235 $dbh->rollback if $oldAutoCommit;
241 #delete the customer record
243 my $error = $self->delete;
245 $dbh->rollback if $oldAutoCommit;
249 $dbh->commit or die $dbh->errstr if $oldAutoCommit;