X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=252a5ca95a1dae878866e74131c57ea34e83c6d3;hb=5d94787d261653677b64bda02166d59aadf98e9a;hp=e1fe4c6daf1ee59b5f55328c05127523389c0e01;hpb=b201bef650fd5818943fcb7ecd123767b1fbcbc3;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index e1fe4c6da..252a5ca95 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,7 +2,7 @@ package FS::cust_main; use strict; use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields - $import $skip_fuzzyfiles $ignore_expired_card ); + $import $skip_fuzzyfiles $ignore_expired_card @paytypes); use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; @@ -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 ); @@ -69,6 +70,7 @@ $skip_fuzzyfiles = 0; $ignore_expired_card = 0; @encrypted_fields = ('payinfo', 'paycvv'); +@paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings'); #ask FS::UID to run this stuff for us later #$FS::UID::callback{'FS::cust_main'} = sub { @@ -417,7 +419,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 @@ -1218,6 +1220,9 @@ sub check { || $self->ut_country('country') || $self->ut_anything('comments') || $self->ut_numbern('referral_custnum') + || $self->ut_textn('stateid') + || $self->ut_textn('stateid_state') + || $self->ut_textn('invoice_terms') ; #barf. need message catalogs. i18n. etc. $error .= "Please select an advertising source." @@ -1332,6 +1337,7 @@ sub check { $error = $self->ut_numbern('paystart_month') || $self->ut_numbern('paystart_year') || $self->ut_numbern('payissue') + || $self->ut_textn('paytype') ; return $error if $error; @@ -1902,7 +1908,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 +2544,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 ) ) { @@ -2600,9 +2612,12 @@ sub realtime_bop { ( $content{account_number}, $content{routing_code} ) = split('@', $payinfo); $content{bank_name} = $o_payname; - $content{account_type} = 'CHECKING'; + $content{bank_state} = $self->getfield('paystate'); + $content{account_type} = uc($self->getfield('paytype')) || 'CHECKING'; $content{account_name} = $payname; $content{customer_org} = $self->company ? 'B' : 'I'; + $content{state_id} = $self->getfield('stateid'); + $content{state_id_state} = $self->getfield('stateid_state'); $content{customer_ssn} = exists($options{'ss'}) ? $options{'ss'} : $self->ss; @@ -2739,10 +2754,12 @@ sub realtime_bop { 'payinfo' => $payinfo, 'paybatch' => $paybatch, } ); - my $error = $cust_pay->insert; + my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () ); if ( $error ) { $cust_pay->invnum(''); #try again with no specific invnum - my $error2 = $cust_pay->insert; + my $error2 = $cust_pay->insert( $options{'manual'} ? + ( 'manual' => 1 ) : () + ); if ( $error2 ) { # gah, even with transactions. my $e = 'WARNING: Card/ACH debited but database not updated - '. @@ -2759,6 +2776,34 @@ sub realtime_bop { my $perror = "$processor error: ". $transaction->error_message; + unless ( $transaction->error_message ) { + + my $t_response; + if ( $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 @@ -2897,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 = ''; @@ -2980,8 +3025,19 @@ sub realtime_refund_bop { if length($auth); #echeck/ACH transactions have an order # but no auth #(at least with authorize.net) + my $disable_void_after; + if ($conf->exists('disable_void_after') + && $conf->config('disable_void_after') =~ /^(\d+)$/) { + $disable_void_after = $1; + } + #first try void if applicable - if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates? + if ( $cust_pay && $cust_pay->paid == $amount + && ( + ( not defined($disable_void_after) ) + || ( time < ($cust_pay->_date + $disable_void_after ) ) + ) + ) { warn " attempting void\n" if $DEBUG > 1; my $void = new Business::OnlinePayment( $processor, @bop_options ); $void->content( 'action' => 'void', %content ); @@ -3019,8 +3075,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 ) ) { @@ -3133,6 +3188,132 @@ sub realtime_refund_bop { } +=item batch_card OPTION => VALUE... + +Adds a payment for this invoice to the pending credit card batch (see +L), or, if the B option is set to a true value, +runs the payment using a realtime gateway. + +=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{invnum} || $self->payby; #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; + + $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), + ); + + 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 payby payinfo paydate + payname )) { + $options{$_} = '' unless exists($options{$_}); + } + + 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} || $self->address1, + 'address2' => $options{address2} || $self->address2, + 'city' => $options{city} || $self->city, + 'state' => $options{state} || $self->state, + 'zip' => $options{zip} || $self->zip, + 'country' => $options{country} || $self->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_credited + $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 @@ -3807,18 +3988,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 @@ -3886,6 +4055,8 @@ sub country_full { code2country($self->country); } +=item cust_status + =item status Returns a status string for this customer, currently: @@ -3906,17 +4077,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. @@ -3932,9 +4121,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 @@ -4087,6 +4278,22 @@ sub fuzzy_search { } +=item masked FIELD + +Returns a masked version of the named field + +=cut + +sub masked { +my ($self,$field) = @_; + +# Show last four + +'x'x(length($self->getfield($field))-4). + substr($self->getfield($field), (length($self->getfield($field))-4)); + +} + =back =head1 SUBROUTINES @@ -4098,7 +4305,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). @@ -4115,6 +4323,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; @@ -4252,7 +4461,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 @@ -4313,7 +4522,7 @@ sub smart_search { FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts ); } - #} + } #eliminate duplicates my %saw = (); @@ -4703,7 +4912,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 @@ -4810,6 +5019,9 @@ payinfo_masked false laziness with cust_pay.pm and cust_refund.pm Birthdates rely on negative epoch values. +The payby for card/check batches is broken. With mixed batching, bad +things will happen. + =head1 SEE ALSO L, L, L, L