FS::cust_main::NationalID
FS::cust_main::Billing
FS::cust_main::Billing_Realtime
+ FS::cust_main::Billing_Batch
FS::cust_main::Billing_Discount
FS::cust_main::Billing_ThirdParty
FS::cust_main::Location
FS::cust_main::Credit_Limit
+ FS::cust_main::Merge
FS::cust_main::API
FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
FS::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin
}
-=item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
-
-This merges this customer into the provided new custnum, and then deletes the
-customer. If there is an error, returns the error, otherwise returns false.
-
-The source customer's name, company name, phone numbers, agent,
-referring customer, customer class, advertising source, order taker, and
-billing information (except balance) are discarded.
-
-All packages are moved to the target customer. Packages with package locations
-are preserved. Packages without package locations are moved to a new package
-location with the source customer's service/shipping address.
-
-All invoices, statements, payments, credits and refunds are moved to the target
-customer. The source customer's balance is added to the target customer.
-
-All notes, attachments, tickets and customer tags are moved to the target
-customer.
-
-Change history is not currently moved.
-
-=cut
-
-sub merge {
- my( $self, $new_custnum, %opt ) = @_;
-
- return "Can't merge a customer into 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";
- }
-
- tie my %financial_tables, 'Tie::IxHash',
- 'cust_bill' => 'invoices',
- 'cust_bill_void' => 'voided invoices',
- 'cust_statement' => 'statements',
- 'cust_credit' => 'credits',
- 'cust_credit_void' => 'voided credits',
- 'cust_pay' => 'payments',
- 'cust_pay_void' => 'voided payments',
- 'cust_refund' => 'refunds',
- ;
-
- foreach my $table ( keys %financial_tables ) {
-
- my @records = $self->$table();
-
- foreach my $record ( @records ) {
- $record->custnum($new_custnum);
- my $error = $record->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error merging ". $financial_tables{$table}. ": $error\n";
- }
- }
-
- }
-
- my $name = $self->ship_name; #?
-
- my $locationnum = '';
- foreach my $cust_pkg ( $self->all_pkgs ) {
- $cust_pkg->custnum($new_custnum);
-
- unless ( $cust_pkg->locationnum ) {
- unless ( $locationnum ) {
- my $cust_location = new FS::cust_location {
- $self->location_hash,
- 'custnum' => $new_custnum,
- };
- my $error = $cust_location->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $locationnum = $cust_location->locationnum;
- }
- $cust_pkg->locationnum($locationnum);
- }
-
- my $error = $cust_pkg->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- # add customer (ship) name to svc_phone.phone_name if blank
- my @cust_svc = $cust_pkg->cust_svc;
- foreach my $cust_svc (@cust_svc) {
- my($label, $value, $svcdb) = $cust_svc->label;
- next unless $svcdb eq 'svc_phone';
- my $svc_phone = $cust_svc->svc_x;
- next if $svc_phone->phone_name;
- $svc_phone->phone_name($name);
- my $error = $svc_phone->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- }
-
- #not considered:
- # cust_tax_exempt (texas tax exemptions)
- # cust_recon (some sort of not-well understood thing for OnPac)
-
- #these are moved over
- foreach my $table (qw(
- cust_tag cust_location contact cust_attachment cust_main_note
- cust_tax_adjustment cust_pay_batch queue
- )) {
- foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
- $record->custnum($new_custnum);
- my $error = $record->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
- #these aren't preserved
- foreach my $table (qw(
- cust_main_exemption cust_main_invoice
- )) {
- foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
- my $error = $record->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
-
- my $sth = $dbh->prepare(
- 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
- ) or do {
- my $errstr = $dbh->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
- $sth->execute($new_custnum, $self->custnum) or do {
- my $errstr = $sth->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
-
- #tickets
-
- my $ticket_dbh = '';
- if ($conf->config('ticket_system') eq 'RT_Internal') {
- $ticket_dbh = $dbh;
- } elsif ($conf->config('ticket_system') eq 'RT_External') {
- my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
- $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
- #or die "RT_External DBI->connect error: $DBI::errstr\n";
- }
-
- if ( $ticket_dbh ) {
-
- my $ticket_sth = $ticket_dbh->prepare(
- 'UPDATE Links SET Target = ? WHERE Target = ?'
- ) or do {
- my $errstr = $ticket_dbh->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
- $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
- 'freeside://freeside/cust_main/'.$self->custnum)
- or do {
- my $errstr = $ticket_sth->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
-
- }
-
- #delete the customer record
-
- my $error = $self->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
Replaces the OLD_RECORD with this one in the database. If there is an error,
'';
}
-=item batch_card OPTION => VALUE...
-
-Adds a payment for this invoice to the pending credit card batch (see
-L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
-runs the payment using a realtime gateway.
-
-Options may include:
-
-B<amount>: the amount to be paid; defaults to the customer's balance minus
-any payments in transit.
-
-B<payby>: the payment method; defaults to cust_main.payby
-
-B<realtime>: runs this as a realtime payment instead of adding it to a
-batch. Deprecated.
-
-B<invnum>: sets cust_pay_batch.invnum.
-
-B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets
-the billing address for the payment; defaults to the customer's billing
-location.
-
-B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration
-date, and name; defaults to those fields in cust_main.
-
-=cut
-
-sub batch_card {
- my ($self, %options) = @_;
-
- my $amount;
- if (exists($options{amount})) {
- $amount = $options{amount};
- }else{
- $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
- }
- return '' unless $amount > 0;
-
- my $invnum = delete $options{invnum};
- my $payby = $options{payby} || $self->payby; #still dubious
-
- if ($options{'realtime'}) {
- return $self->realtime_bop( FS::payby->payby2bop($self->payby),
- $amount,
- %options,
- );
- }
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- #this needs to handle mysql as well as Pg, like svc_acct.pm
- #(make it into a common function if folks need to do batching with mysql)
- $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
- or return "Cannot lock pay_batch: " . $dbh->errstr;
-
- my %pay_batch = (
- 'status' => 'O',
- 'payby' => FS::payby->payby2payment($payby),
- );
- $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
-
- my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
-
- unless ( $pay_batch ) {
- $pay_batch = new FS::pay_batch \%pay_batch;
- my $error = $pay_batch->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die "error creating new batch: $error\n";
- }
- }
-
- my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
- 'batchnum' => $pay_batch->batchnum,
- 'custnum' => $self->custnum,
- } );
-
- foreach (qw( address1 address2 city state zip country latitude longitude
- payby payinfo paydate payname ))
- {
- $options{$_} = '' unless exists($options{$_});
- }
-
- my $loc = $self->bill_location;
-
- my $cust_pay_batch = new FS::cust_pay_batch ( {
- 'batchnum' => $pay_batch->batchnum,
- 'invnum' => $invnum || 0, # is there a better value?
- # this field should be
- # removed...
- # cust_bill_pay_batch now
- 'custnum' => $self->custnum,
- 'last' => $self->getfield('last'),
- 'first' => $self->getfield('first'),
- 'address1' => $options{address1} || $loc->address1,
- 'address2' => $options{address2} || $loc->address2,
- 'city' => $options{city} || $loc->city,
- 'state' => $options{state} || $loc->state,
- 'zip' => $options{zip} || $loc->zip,
- 'country' => $options{country} || $loc->country,
- 'payby' => $options{payby} || $self->payby,
- 'payinfo' => $options{payinfo} || $self->payinfo,
- 'exp' => $options{paydate} || $self->paydate,
- 'payname' => $options{payname} || $self->payname,
- 'amount' => $amount, # consolidating
- } );
-
- $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
- if $old_cust_pay_batch;
-
- my $error;
- if ($old_cust_pay_batch) {
- $error = $cust_pay_batch->replace($old_cust_pay_batch)
- } else {
- $error = $cust_pay_batch->insert;
- }
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die $error;
- }
-
- my $unapplied = $self->total_unapplied_credits
- + $self->total_unapplied_payments
- + $self->in_transit_payments;
- foreach my $cust_bill ($self->open_cust_bill) {
- #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
- my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
- 'invnum' => $cust_bill->invnum,
- 'paybatchnum' => $cust_pay_batch->paybatchnum,
- 'amount' => $cust_bill->owed,
- '_date' => time,
- };
- if ($unapplied >= $cust_bill_pay_batch->amount){
- $unapplied -= $cust_bill_pay_batch->amount;
- next;
- }else{
- $cust_bill_pay_batch->amount(sprintf ( "%.2f",
- $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
- }
- $error = $cust_bill_pay_batch->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-}
-
=item total_owed
Returns the total owed for this customer on all invoices
);
}
-=item in_transit_payments
-
-Returns the total of requests for payments for this customer pending in
-batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
-
-=cut
-
-sub in_transit_payments {
- my $self = shift;
- my $in_transit_payments = 0;
- foreach my $pay_batch ( qsearch('pay_batch', {
- 'status' => 'I',
- } ) ) {
- foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
- 'batchnum' => $pay_batch->batchnum,
- 'custnum' => $self->custnum,
- } ) ) {
- $in_transit_payments += $cust_pay_batch->amount;
- }
- }
- sprintf( "%.2f", $in_transit_payments );
-}
-
=item payment_info
Returns a hash of useful information for making a payment.
qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
}
-=item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
-
-Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
-
-Optionally, a list or hashref of additional arguments to the qsearch call can
-be passed.
-
-=cut
-
-sub cust_pay_batch {
- my $self = shift;
- my $opt = ref($_[0]) ? shift : { @_ };
-
- #return $self->num_cust_statement unless wantarray || keys %$opt;
-
- $opt->{'table'} = 'cust_pay_batch';
- $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
- $opt->{'hashref'}{'custnum'} = $self->custnum;
- $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
-
- map { $_ } #behavior of sort undefined in scalar context
- sort { $a->paybatchnum <=> $b->paybatchnum }
- qsearch($opt);
-}
-
=item cust_pay_pending
Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
--- /dev/null
+package FS::cust_main::Billing_Batch;
+
+use strict;
+use vars qw( $conf );
+use FS::Record qw( qsearch qsearchs dbh );
+use FS::pay_batch;
+use FS::cust_pay_batch;
+
+install_callback FS::UID sub {
+ $conf = new FS::Conf;
+ #yes, need it for stuff below (prolly should be cached)
+};
+
+=item batch_card OPTION => VALUE...
+
+Adds a payment for this invoice to the pending credit card batch (see
+L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
+runs the payment using a realtime gateway.
+
+Options may include:
+
+B<amount>: the amount to be paid; defaults to the customer's balance minus
+any payments in transit.
+
+B<payby>: the payment method; defaults to cust_main.payby
+
+B<realtime>: runs this as a realtime payment instead of adding it to a
+batch. Deprecated.
+
+B<invnum>: sets cust_pay_batch.invnum.
+
+B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets
+the billing address for the payment; defaults to the customer's billing
+location.
+
+B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration
+date, and name; defaults to those fields in cust_main.
+
+=cut
+
+sub batch_card {
+ my ($self, %options) = @_;
+
+ my $amount;
+ if (exists($options{amount})) {
+ $amount = $options{amount};
+ }else{
+ $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
+ }
+ return '' unless $amount > 0;
+
+ my $invnum = delete $options{invnum};
+ my $payby = $options{payby} || $self->payby; #still dubious
+
+ if ($options{'realtime'}) {
+ return $self->realtime_bop( FS::payby->payby2bop($self->payby),
+ $amount,
+ %options,
+ );
+ }
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ #this needs to handle mysql as well as Pg, like svc_acct.pm
+ #(make it into a common function if folks need to do batching with mysql)
+ $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
+ or return "Cannot lock pay_batch: " . $dbh->errstr;
+
+ my %pay_batch = (
+ 'status' => 'O',
+ 'payby' => FS::payby->payby2payment($payby),
+ );
+ $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
+
+ my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
+
+ unless ( $pay_batch ) {
+ $pay_batch = new FS::pay_batch \%pay_batch;
+ my $error = $pay_batch->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ die "error creating new batch: $error\n";
+ }
+ }
+
+ my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
+ 'batchnum' => $pay_batch->batchnum,
+ 'custnum' => $self->custnum,
+ } );
+
+ foreach (qw( address1 address2 city state zip country latitude longitude
+ payby payinfo paydate payname ))
+ {
+ $options{$_} = '' unless exists($options{$_});
+ }
+
+ my $loc = $self->bill_location;
+
+ my $cust_pay_batch = new FS::cust_pay_batch ( {
+ 'batchnum' => $pay_batch->batchnum,
+ 'invnum' => $invnum || 0, # is there a better value?
+ # this field should be
+ # removed...
+ # cust_bill_pay_batch now
+ 'custnum' => $self->custnum,
+ 'last' => $self->getfield('last'),
+ 'first' => $self->getfield('first'),
+ 'address1' => $options{address1} || $loc->address1,
+ 'address2' => $options{address2} || $loc->address2,
+ 'city' => $options{city} || $loc->city,
+ 'state' => $options{state} || $loc->state,
+ 'zip' => $options{zip} || $loc->zip,
+ 'country' => $options{country} || $loc->country,
+ 'payby' => $options{payby} || $self->payby,
+ 'payinfo' => $options{payinfo} || $self->payinfo,
+ 'exp' => $options{paydate} || $self->paydate,
+ 'payname' => $options{payname} || $self->payname,
+ 'amount' => $amount, # consolidating
+ } );
+
+ $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
+ if $old_cust_pay_batch;
+
+ my $error;
+ if ($old_cust_pay_batch) {
+ $error = $cust_pay_batch->replace($old_cust_pay_batch)
+ } else {
+ $error = $cust_pay_batch->insert;
+ }
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ die $error;
+ }
+
+ my $unapplied = $self->total_unapplied_credits
+ + $self->total_unapplied_payments
+ + $self->in_transit_payments;
+ foreach my $cust_bill ($self->open_cust_bill) {
+ #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
+ 'invnum' => $cust_bill->invnum,
+ 'paybatchnum' => $cust_pay_batch->paybatchnum,
+ 'amount' => $cust_bill->owed,
+ '_date' => time,
+ };
+ if ($unapplied >= $cust_bill_pay_batch->amount){
+ $unapplied -= $cust_bill_pay_batch->amount;
+ next;
+ }else{
+ $cust_bill_pay_batch->amount(sprintf ( "%.2f",
+ $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
+ }
+ $error = $cust_bill_pay_batch->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ die $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+}
+
+=item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
+
+Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
+
+Optionally, a list or hashref of additional arguments to the qsearch call can
+be passed.
+
+=cut
+
+sub cust_pay_batch {
+ my $self = shift;
+ my $opt = ref($_[0]) ? shift : { @_ };
+
+ #return $self->num_cust_statement unless wantarray || keys %$opt;
+
+ $opt->{'table'} = 'cust_pay_batch';
+ $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
+ $opt->{'hashref'}{'custnum'} = $self->custnum;
+ $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
+
+ map { $_ } #behavior of sort undefined in scalar context
+ sort { $a->paybatchnum <=> $b->paybatchnum }
+ qsearch($opt);
+}
+
+=item in_transit_payments
+
+Returns the total of requests for payments for this customer pending in
+batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
+
+=cut
+
+sub in_transit_payments {
+ my $self = shift;
+ my $in_transit_payments = 0;
+ foreach my $pay_batch ( qsearch('pay_batch', {
+ 'status' => 'I',
+ } ) ) {
+ foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
+ 'batchnum' => $pay_batch->batchnum,
+ 'custnum' => $self->custnum,
+ } ) ) {
+ $in_transit_payments += $cust_pay_batch->amount;
+ }
+ }
+ sprintf( "%.2f", $in_transit_payments );
+}
+
+1;
--- /dev/null
+package FS::cust_main::Merge;
+
+use strict;
+use vars qw( $conf );
+use FS::UID qw( dbh );
+use FS::Record qw( qsearch qsearchs );
+use FS::agent;
+use FS::access_user;
+use FS::cust_pay_pending;
+use FS::cust_tag;
+use FS::cust_location;
+use FS::contact;
+use FS::cust_attachment;
+use FS::cust_main_note;
+use FS::cust_tax_adjustment;
+use FS::cust_pay_batch;
+use FS::queue;
+use FS::cust_main_exemption;
+use FS::cust_main_invoice;
+
+install_callback FS::UID sub {
+ $conf = new FS::Conf;
+ #yes, need it for stuff below (prolly should be cached)
+};
+
+#old-style merge, new style is with ->attach_pkgs
+
+=item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
+
+This merges this customer into the provided new custnum, and then deletes the
+customer. If there is an error, returns the error, otherwise returns false.
+
+The source customer's name, company name, phone numbers, agent,
+referring customer, customer class, advertising source, order taker, and
+billing information (except balance) are discarded.
+
+All packages are moved to the target customer. Packages with package locations
+are preserved. Packages without package locations are moved to a new package
+location with the source customer's service/shipping address.
+
+All invoices, statements, payments, credits and refunds are moved to the target
+customer. The source customer's balance is added to the target customer.
+
+All notes, attachments, tickets and customer tags are moved to the target
+customer.
+
+Change history is not currently moved.
+
+=cut
+
+sub merge {
+ my( $self, $new_custnum, %opt ) = @_;
+
+ return "Can't merge a customer into 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";
+ }
+
+ tie my %financial_tables, 'Tie::IxHash',
+ 'cust_bill' => 'invoices',
+ 'cust_bill_void' => 'voided invoices',
+ 'cust_statement' => 'statements',
+ 'cust_credit' => 'credits',
+ 'cust_credit_void' => 'voided credits',
+ 'cust_pay' => 'payments',
+ 'cust_pay_void' => 'voided payments',
+ 'cust_refund' => 'refunds',
+ ;
+
+ foreach my $table ( keys %financial_tables ) {
+
+ my @records = $self->$table();
+
+ foreach my $record ( @records ) {
+ $record->custnum($new_custnum);
+ my $error = $record->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error merging ". $financial_tables{$table}. ": $error\n";
+ }
+ }
+
+ }
+
+ my $name = $self->ship_name; #?
+
+ my $locationnum = '';
+ foreach my $cust_pkg ( $self->all_pkgs ) {
+ $cust_pkg->custnum($new_custnum);
+
+ unless ( $cust_pkg->locationnum ) {
+ unless ( $locationnum ) {
+ my $cust_location = new FS::cust_location {
+ $self->location_hash,
+ 'custnum' => $new_custnum,
+ };
+ my $error = $cust_location->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ $locationnum = $cust_location->locationnum;
+ }
+ $cust_pkg->locationnum($locationnum);
+ }
+
+ my $error = $cust_pkg->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ # add customer (ship) name to svc_phone.phone_name if blank
+ my @cust_svc = $cust_pkg->cust_svc;
+ foreach my $cust_svc (@cust_svc) {
+ my($label, $value, $svcdb) = $cust_svc->label;
+ next unless $svcdb eq 'svc_phone';
+ my $svc_phone = $cust_svc->svc_x;
+ next if $svc_phone->phone_name;
+ $svc_phone->phone_name($name);
+ my $error = $svc_phone->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ }
+
+ #not considered:
+ # cust_tax_exempt (texas tax exemptions)
+ # cust_recon (some sort of not-well understood thing for OnPac)
+
+ #these are moved over
+ foreach my $table (qw(
+ cust_tag cust_location contact cust_attachment cust_main_note
+ cust_tax_adjustment cust_pay_batch queue
+ )) {
+ foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
+ $record->custnum($new_custnum);
+ my $error = $record->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+
+ #these aren't preserved
+ foreach my $table (qw(
+ cust_main_exemption cust_main_invoice
+ )) {
+ foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
+ my $error = $record->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+
+
+ my $sth = $dbh->prepare(
+ 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
+ ) or do {
+ my $errstr = $dbh->errstr;
+ $dbh->rollback if $oldAutoCommit;
+ return $errstr;
+ };
+ $sth->execute($new_custnum, $self->custnum) or do {
+ my $errstr = $sth->errstr;
+ $dbh->rollback if $oldAutoCommit;
+ return $errstr;
+ };
+
+ #tickets
+
+ my $ticket_dbh = '';
+ if ($conf->config('ticket_system') eq 'RT_Internal') {
+ $ticket_dbh = $dbh;
+ } elsif ($conf->config('ticket_system') eq 'RT_External') {
+ my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
+ $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
+ #or die "RT_External DBI->connect error: $DBI::errstr\n";
+ }
+
+ if ( $ticket_dbh ) {
+
+ my $ticket_sth = $ticket_dbh->prepare(
+ 'UPDATE Links SET Target = ? WHERE Target = ?'
+ ) or do {
+ my $errstr = $ticket_dbh->errstr;
+ $dbh->rollback if $oldAutoCommit;
+ return $errstr;
+ };
+ $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
+ 'freeside://freeside/cust_main/'.$self->custnum)
+ or do {
+ my $errstr = $ticket_sth->errstr;
+ $dbh->rollback if $oldAutoCommit;
+ return $errstr;
+ };
+
+ }
+
+ #delete the customer record
+
+ my $error = $self->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
+1;
+
FS/cust_credit_bill.pm
FS/cust_main.pm
FS/cust_main/Billing.pm
+FS/cust_main/Billing_Batch.pm
FS/cust_main/Billing_Discount.pm
FS/cust_main/Billing_Realtime.pm
FS/cust_main/Import.pm
FS/cust_main/Import_Charges.pm
+FS/cust_main/Merge.pm
FS/cust_main/Packages.pm
FS/cust_main/Search.pm
+FS/cust_main/Status.pm
FS/cust_main_Mixin.pm
FS/cust_main_county.pm
FS/cust_main_invoice.pm
t/svc_port.t
FS/h_svc_port.pm
t/h_svc_port.t
-FS/cust_main/Status.pm
FS/NetworkMonitoringSystem.pm
FS/NetworkMonitoringSystem/Torrus_Internal.pm
FS/lata.pm
projects / freeside.git / commitdiff