1 package FS::cust_main::Merge;
7 use FS::Record qw( qsearch qsearchs );
10 use FS::cust_pay_pending;
12 use FS::cust_location;
14 use FS::cust_attachment;
15 use FS::cust_main_note;
16 use FS::cust_tax_adjustment;
17 use FS::cust_pay_batch;
19 use FS::cust_main_exemption;
20 use FS::cust_main_invoice;
22 install_callback FS::UID sub {
24 #yes, need it for stuff below (prolly should be cached)
27 #old-style merge, new style is with ->attach_pkgs
29 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
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.
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.
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.
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.
45 All notes, attachments, tickets and customer tags are moved to the target
48 Change history is not currently moved.
53 my( $self, $new_custnum, %opt ) = @_;
55 return "Can't merge a customer into self" if $self->custnum == $new_custnum;
57 my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
58 or return "Invalid new customer number: $new_custnum";
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');
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';
71 my $oldAutoCommit = $FS::UID::AutoCommit;
72 local $FS::UID::AutoCommit = 0;
75 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
76 $dbh->rollback if $oldAutoCommit;
77 return "Can't merge a master agent customer";
81 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
82 $dbh->rollback if $oldAutoCommit;
83 return "Can't merge a master employee customer";
86 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
87 'status' => { op=>'!=', value=>'done' },
91 $dbh->rollback if $oldAutoCommit;
92 return "Can't merge a customer with pending payments";
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',
106 foreach my $table ( keys %financial_tables ) {
108 my @records = $self->$table();
110 foreach my $record ( @records ) {
111 $record->custnum($new_custnum);
112 my $error = $record->replace;
114 $dbh->rollback if $oldAutoCommit;
115 return "Error merging ". $financial_tables{$table}. ": $error\n";
121 my $name = $self->ship_name; #?
123 my $locationnum = '';
124 foreach my $cust_pkg ( $self->all_pkgs ) {
125 $cust_pkg->custnum($new_custnum);
127 unless ( $cust_pkg->locationnum ) {
128 unless ( $locationnum ) {
129 my $cust_location = new FS::cust_location {
130 $self->location_hash,
131 'custnum' => $new_custnum,
133 my $error = $cust_location->insert;
135 $dbh->rollback if $oldAutoCommit;
138 $locationnum = $cust_location->locationnum;
140 $cust_pkg->locationnum($locationnum);
143 my $error = $cust_pkg->replace;
145 $dbh->rollback if $oldAutoCommit;
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;
159 $dbh->rollback if $oldAutoCommit;
167 # cust_tax_exempt (texas tax exemptions)
168 # cust_recon (some sort of not-well understood thing for OnPac)
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
175 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
176 $record->custnum($new_custnum);
177 my $error = $record->replace;
179 $dbh->rollback if $oldAutoCommit;
185 #these aren't preserved
186 foreach my $table (qw(
187 cust_main_exemption cust_main_invoice
189 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
190 my $error = $record->delete;
192 $dbh->rollback if $oldAutoCommit;
199 my $sth = $dbh->prepare(
200 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
202 my $errstr = $dbh->errstr;
203 $dbh->rollback if $oldAutoCommit;
206 $sth->execute($new_custnum, $self->custnum) or do {
207 my $errstr = $sth->errstr;
208 $dbh->rollback if $oldAutoCommit;
215 if ($conf->config('ticket_system') eq 'RT_Internal') {
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";
225 my $ticket_sth = $ticket_dbh->prepare(
226 'UPDATE Links SET Target = ? WHERE Target = ?'
228 my $errstr = $ticket_dbh->errstr;
229 $dbh->rollback if $oldAutoCommit;
232 $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
233 'freeside://freeside/cust_main/'.$self->custnum)
235 my $errstr = $ticket_sth->errstr;
236 $dbh->rollback if $oldAutoCommit;
242 #delete the customer record
244 my $error = $self->delete;
246 $dbh->rollback if $oldAutoCommit;
250 $dbh->commit or die $dbh->errstr if $oldAutoCommit;