diff options
Diffstat (limited to 'FS/FS/cust_main.pm')
-rw-r--r-- | FS/FS/cust_main.pm | 403 |
1 files changed, 119 insertions, 284 deletions
diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 7969965..fc781d2 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -6,7 +6,6 @@ use strict; use base qw( FS::cust_main::Packages FS::cust_main::Billing FS::cust_main::Billing_Realtime FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin - FS::geocode_Mixin FS::Record ); use vars qw( $DEBUG $me $conf @@ -26,7 +25,7 @@ use Tie::IxHash; use Digest::MD5 qw(md5_base64); use Date::Format; #use Date::Manip; -use File::Temp; #qw( tempfile ); +use File::Temp qw( tempfile ); use Business::CreditCard 0.28; use Locale::Country; use FS::UID qw( getotaker dbh driver_name ); @@ -1159,227 +1158,6 @@ sub delete { } -=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; - - unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) { - return "Invalid new customer number: $new_custnum"; - } - - 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_statement' => 'statements', - 'cust_credit' => '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 ... ] ] @@ -1421,17 +1199,6 @@ sub replace { return "You are not permitted to create complimentary accounts."; } - if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode') - && $conf->exists('enable_taxproducts') - ) - { - my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip) - ? 'ship_' : ''; - $self->set('geocode', '') - if $old->get($pre.'zip') ne $self->get($pre.'zip') - && length($self->get($pre.'zip')) >= 10; - } - local($ignore_expired_card) = 1 if $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/ @@ -1888,14 +1655,12 @@ sub check { $self->payinfo($payinfo); $self->paycvv(''); - unless ( $ignore_banned_card ) { - my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - if ( $ban ) { - return 'Banned ACH account: banned on '. - time2str('%a %h %o at %r', $ban->_date). - ' by '. $ban->otaker. - ' (ban# '. $ban->bannum. ')'; - } + my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); + if ( $ban ) { + return 'Banned ACH account: banned on '. + time2str('%a %h %o at %r', $ban->_date). + ' by '. $ban->otaker. + ' (ban# '. $ban->bannum. ')'; } } elsif ( $self->payby eq 'LECB' ) { @@ -1955,7 +1720,6 @@ sub check { } else { return "Illegal expiration date: ". $self->paydate; } - $m = sprintf('%02d',$m); $self->paydate("$y-$m-01"); my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; return gettext('expired_card') @@ -1970,7 +1734,7 @@ sub check { ) { $self->payname( $self->first. " ". $self->getfield('last') ); } else { - $self->payname =~ /^([µ_0123456789aAáÁàÀâÂåÅäÄãêæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFgGhHiIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøغpPqQrRsSßtTuUúÚùÙûÛüÜvVwWxXyYýÝÿzZþÞ \,\.\-\'\&]+)$/ + $self->payname =~ /^([\w \,\.\-\'\&]+)$/ or return gettext('illegal_name'). " payname: ". $self->payname; $self->payname($1); } @@ -2015,10 +1779,22 @@ sub has_ship_address { =item location_hash Returns a list of key/value pairs, with the following keys: address1, adddress2, -city, county, state, zip, country, and geocode. The shipping address is used if present. +city, county, state, zip, country. The shipping address is used if present. =cut +#geocode? dependent on tax-ship_address config, not available in cust_location +#mostly. not yet then. + +sub location_hash { + my $self = shift; + my $prefix = $self->has_ship_address ? 'ship_' : ''; + + map { $_ => $self->get($prefix.$_) } + qw( address1 address2 city county state zip country geocode ); + #fields that cust_location has +} + =item cust_location Returns all locations (see L<FS::cust_location>) for this customer. @@ -2030,6 +1806,61 @@ sub cust_location { qsearch('cust_location', { 'custnum' => $self->custnum } ); } +=item location_label [ OPTION => VALUE ... ] + +Returns the label of the service location (see analog in L<FS::cust_location>) for this customer. + +Options are + +=over 4 + +=item join_string + +used to separate the address elements (defaults to ', ') + +=item escape_function + +a callback used for escaping the text of the address elements + +=back + +=cut + +# false laziness with FS::cust_location::line + +sub location_label { + my $self = shift; + my %opt = @_; + + my $separator = $opt{join_string} || ', '; + my $escape = $opt{escape_function} || sub{ shift }; + my $line = ''; + my $cydefault = FS::conf->new->config('countrydefault') || 'US'; + my $prefix = length($self->ship_last) ? 'ship_' : ''; + + my $notfirst = 0; + foreach (qw ( address1 address2 ) ) { + my $method = "$prefix$_"; + $line .= ($notfirst ? $separator : ''). &$escape($self->$method) + if $self->$method; + $notfirst++; + } + $notfirst = 0; + foreach (qw ( city county state zip ) ) { + my $method = "$prefix$_"; + if ( $self->$method ) { + $line .= ' (' if $method eq 'county'; + $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method); + $line .= ' )' if $method eq 'county'; + $notfirst++; + } + } + $line .= $separator. &$escape(code2country($self->country)) + if $self->country ne $cydefault; + + $line; +} + =item unsuspend Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs> @@ -2502,7 +2333,7 @@ sub total_owed_date { AND _date <= $time "; - sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); + sprintf( "%.2f", $self->scalar_sql($sql) ); } @@ -2582,7 +2413,7 @@ sub total_unapplied_credits { WHERE custnum = $custnum "; - sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); + sprintf( "%.2f", $self->scalar_sql($sql) ); } @@ -2620,7 +2451,7 @@ sub total_unapplied_payments { WHERE custnum = $custnum "; - sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); + sprintf( "%.2f", $self->scalar_sql($sql) ); } @@ -2658,7 +2489,7 @@ sub total_unapplied_refunds { WHERE custnum = $custnum "; - sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); + sprintf( "%.2f", $self->scalar_sql($sql) ); } @@ -2716,7 +2547,7 @@ sub balance_date_range { my $self = shift; my $sql = 'SELECT SUM('. $self->balance_date_sql(@_). ') FROM cust_main WHERE custnum='. $self->custnum; - sprintf( '%.2f', $self->scalar_sql($sql) || 0 ); + sprintf( '%.2f', $self->scalar_sql($sql) ); } =item balance_pkgnum PKGNUM @@ -3785,6 +3616,38 @@ Currently this only makes sense for "CCH" as DATA_VENDOR. =cut +sub geocode { + my ($self, $data_vendor) = (shift, shift); #always cch for now + + my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode + return $geocode if $geocode; + + my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) ) + ? 'ship_' + : ''; + + my($zip,$plus4) = split /-/, $self->get("${prefix}zip") + if $self->country eq 'US'; + + $zip ||= ''; + $plus4 ||= ''; + #CCH specific location stuff + my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'"; + + my @cust_tax_location = + qsearch( { + 'table' => 'cust_tax_location', + 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor }, + 'extra_sql' => $extra_sql, + 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends + } + ); + $geocode = $cust_tax_location[0]->geocode + if scalar(@cust_tax_location); + + $geocode; +} + =item cust_status =item status @@ -3813,6 +3676,7 @@ sub status { shift->cust_status(@_); } sub cust_status { my $self = shift; + # prospect ordered active inactive suspended cancelled for my $status ( FS::cust_main->statuses() ) { my $method = $status.'_sql'; my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g; @@ -3849,9 +3713,9 @@ tie %statuscolor, 'Tie::IxHash', 'prospect' => '7e0079', #'000000', #black? naw, purple 'active' => '00CC00', #green 'ordered' => '009999', #teal? cyan? + 'inactive' => '0000CC', #blue 'suspended' => 'FF9900', #yellow 'cancelled' => 'FF0000', #red - 'inactive' => '0000CC', #blue ; sub statuscolor { shift->cust_statuscolor(@_); } @@ -3958,24 +3822,6 @@ sub statuses { keys %statuscolor; } -=item cust_status_sql - -Returns an SQL fragment to determine the status of a cust_main record, as a -string. - -=cut - -sub cust_status_sql { - my $sql = 'CASE'; - for my $status ( FS::cust_main->statuses() ) { - my $method = $status.'_sql'; - $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'"; - } - $sql .= ' END'; - return $sql; -} - - =item prospect_sql Returns an SQL expression identifying prospective cust_main records (customers @@ -4076,8 +3922,8 @@ sub cancel_sql { AND 0 = ( $select_count_pkgs AND $recurring_sql AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) ) + AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) "; -# AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) } @@ -4763,21 +4609,10 @@ sub process_bill_and_collect { sub _upgrade_data { #class method my ($class, %opts) = @_; - my @statements = ( + foreach my $sql ( 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL', - 'UPDATE cust_main SET signupdate = (SELECT signupdate FROM h_cust_main WHERE signupdate IS NOT NULL AND h_cust_main.custnum = cust_main.custnum ORDER BY historynum DESC LIMIT 1) WHERE signupdate IS NULL', - ); - # fix yyyy-m-dd formatted paydates - if ( driver_name =~ /^mysql$/i ) { - push @statements, - "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'"; - } - else { # the SQL standard - push @statements, - "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'"; - } - - foreach my $sql ( @statements ) { + 'UPDATE cust_main SET signupdate = (SELECT signupdate FROM h_cust_main WHERE h_cust_main.custnum = cust_main.custnum ORDER BY historynum ASC LIMIT 1) WHERE signupdate IS NULL', + ) { my $sth = dbh->prepare($sql) or die dbh->errstr; $sth->execute or die $sth->errstr; } |