X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=d437db69481a102e8dd74e6cbc898d230fdd810e;hb=fce19eeca97b74dbc3706da931d6cdf4bf7f0337;hp=66d7553c20bde4378d1ecf57074487709c9a572d;hpb=a7ea8cde763b396d0f4ce48168c689d038263786;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 66d7553c2..d437db694 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -21,6 +21,7 @@ use Date::Parse; use String::Approx qw(amatch); use Business::CreditCard 0.28; use Locale::Country; +use Data::Dumper; use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearchs qsearch dbdef ); use FS::Misc qw( send_email ); @@ -417,7 +418,7 @@ sub start_copy_skel { #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' }, #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' }, #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } }, - my @tables = eval($conf->config_binary('cust_main-skeleton_tables')); + my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables'))); die $@ if $@; _copy_skel( 'cust_main', #tablename @@ -1902,7 +1903,14 @@ sub bill { ### my $setup = 0; - if ( !$cust_pkg->setup || $options{'resetup'} ) { + if ( ! $cust_pkg->setup && + ( + ( $conf->exists('disable_setup_suspended_pkgs') && + ! $cust_pkg->getfield('susp') + ) || ! $conf->exists('disable_setup_suspended_pkgs') + ) + || $options{'resetup'} + ) { warn " bill setup\n" if $DEBUG > 1; @@ -2531,8 +2539,7 @@ sub realtime_bop { $payname = "$payfirst $paylast"; } - # invoicing_list_emailonly instead? push one? which one? - my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; + my @invoicing_list = $self->invoicing_list_emailonly; if ( $conf->exists('emailinvoiceautoalways') || $conf->exists('emailinvoiceauto') && ! @invoicing_list || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { @@ -2761,6 +2768,42 @@ sub realtime_bop { my $perror = "$processor error: ". $transaction->error_message; + unless ( $transaction->error_message ) { + + my $t_response; + #this should be normalized :/ + # + # bad, ad-hoc B:OP:PayflowPro "transaction_response" BS + if ( $transaction->can('param') + && $transaction->param('transaction_response') ) { + $t_response = $transaction->param('transaction_response') + + # slightly better, ad-hoc B:OP:TransactionCentral without "param" + } elsif ( $transaction->can('response_page') ) { + $t_response = { + 'page' => ( $transaction->can('response_page') + ? $transaction->response_page + : '' + ), + 'code' => ( $transaction->can('response_code') + ? $transaction->response_code + : '' + ), + 'headers' => ( $transaction->can('response_headers') + ? $transaction->response_headers + : '' + ), + }; + } else { + $t_response .= + "No additional debugging information available for $processor"; + } + + $perror .= "No error_message returned from $processor -- ". + ( ref($t_response) ? Dumper($t_response) : $t_response ); + + } + if ( !$options{'quiet'} && !$realtime_bop_decline_quiet && $conf->exists('emaildecline') && grep { $_ ne 'POST' } $self->invoicing_list @@ -2899,7 +2942,7 @@ sub realtime_refund_bop { or return "Unknown paynum $options{'paynum'}"; $amount ||= $cust_pay->paid; - $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/ + $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/ or return "Can't parse paybatch for paynum $options{'paynum'}: ". $cust_pay->paybatch; my $gatewaynum = ''; @@ -3021,8 +3064,7 @@ sub realtime_refund_bop { $payname = "$payfirst $paylast"; } - # invoicing_list_emailonly instead? push one? which one? - my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; + my @invoicing_list = $self->invoicing_list_emailonly; if ( $conf->exists('emailinvoiceautoalways') || $conf->exists('emailinvoiceauto') && ! @invoicing_list || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { @@ -3809,18 +3851,6 @@ sub cust_refund { qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) } -=item select_for_update - -Selects this record with the SQL "FOR UPDATE" command. This can be useful as -a mutex. - -=cut - -sub select_for_update { - my $self = shift; - qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' ); -} - =item name Returns a name string for this customer, either "Company (Last, First)" or @@ -3888,6 +3918,8 @@ sub country_full { code2country($self->country); } +=item cust_status + =item status Returns a status string for this customer, currently: @@ -3908,17 +3940,35 @@ Returns a status string for this customer, currently: =cut -sub status { +sub status { shift->cust_status(@_); } + +sub cust_status { my $self = shift; for my $status (qw( prospect active inactive suspended cancelled )) { my $method = $status.'_sql'; my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g; my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr; - $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr; + $sth->execute( ($self->custnum) x $numnum ) + or die "Error executing 'SELECT $sql': ". $sth->errstr; return $status if $sth->fetchrow_arrayref->[0]; } } +=item ucfirst_cust_status + +=item ucfirst_status + +Returns the status with the first character capitalized. + +=cut + +sub ucfirst_status { shift->ucfirst_cust_status(@_); } + +sub ucfirst_cust_status { + my $self = shift; + ucfirst($self->cust_status); +} + =item statuscolor Returns a hex triplet color string for this customer's status. @@ -3934,9 +3984,11 @@ use vars qw(%statuscolor); 'cancelled' => 'FF0000', #red ); -sub statuscolor { +sub statuscolor { shift->cust_statuscolor(@_); } + +sub cust_statuscolor { my $self = shift; - $statuscolor{$self->status}; + $statuscolor{$self->cust_status}; } =back @@ -4100,7 +4152,8 @@ sub fuzzy_search { Accepts the following options: I, the string to search for. The string will be searched for as a customer number, phone number, name or company name, as an exact, or, in some cases, a substring or fuzzy match (see the source code -for the exact heuristics used). +for the exact heuristics used); I, causes smart_search to +skip fuzzy matching when an exact match is found. Any additional options are treated as an additional qualifier on the search (i.e. I). @@ -4117,6 +4170,7 @@ sub smart_search { my @cust_main = (); + my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'}; my $search = delete $options{'search'}; ( my $alphanum_search = $search ) =~ s/\W//g; @@ -4254,7 +4308,7 @@ sub smart_search { #always do substring & fuzzy, #getting complains searches are not returning enough - #unless ( @cust_main ) { #no exact match, trying substring/fuzzy + unless ( @cust_main && $skip_fuzzy ) { #no exact match, trying substring/fuzzy #still some false laziness w/ search/cust_main.cgi @@ -4315,7 +4369,7 @@ sub smart_search { FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts ); } - #} + } #eliminate duplicates my %saw = (); @@ -4705,7 +4759,7 @@ sub batch_charge { =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS -Sends a templated email notification to the customer (see L). OPTIONS is a hash and may include