X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=f1d969cd16de41c33d9cdb91253c7dc65853d431;hb=97316d268e5751a1d08a0a37e5a0456f2ce4815c;hp=62e6a5c44507ef3370374bf28df9eb89e41199b3;hpb=b9f9a5dc444a66ca138073a0e5229d85569e51b4;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 62e6a5c44..f1d969cd1 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -20,6 +20,7 @@ use Date::Parse; #use Date::Manip; use String::Approx qw(amatch); use Business::CreditCard 0.28; +use Locale::Country; use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearchs qsearch dbdef ); use FS::Misc qw( send_email ); @@ -79,7 +80,7 @@ sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; if ( exists $hashref->{'pkgnum'} ) { -# #@{ $self->{'_pkgnum'} } = (); + #@{ $self->{'_pkgnum'} } = (); my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum}); $self->{'_pkgnum'} = $subcache; #push @{ $self->{'_pkgnum'} }, @@ -923,6 +924,8 @@ sub replace { my $self = shift; my $old = shift; my @param = @_; + warn "$me replace called\n" + if $DEBUG; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -941,10 +944,13 @@ sub replace { $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } - if ( $self->payby eq 'COMP' && $self->payby ne $old->payby - && $conf->config('users-allow_comp') ) { - return "You are not permitted to create complimentary accounts." - unless grep { $_ eq getotaker } $conf->config('users-allow_comp'); + my $curuser = $FS::CurrentUser::CurrentUser; + if ( $self->payby eq 'COMP' + && $self->payby ne $old->payby + && ! $curuser->access_right('Complimentary customer') + ) + { + return "You are not permitted to create complimentary accounts."; } local($ignore_expired_card) = 1 @@ -1213,7 +1219,12 @@ sub check { if cardtype($self->payinfo) eq "Unknown"; my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - return "Banned credit card" if $ban; + if ( $ban ) { + return 'Banned credit card: banned on '. + time2str('%a %h %o at %r', $ban->_date). + ' by '. $ban->otaker. + ' (ban# '. $ban->bannum. ')'; + } if ( defined $self->dbdef_table->column('paycvv') ) { if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { @@ -1261,15 +1272,21 @@ sub check { $payinfo =~ s/[^\d\@]//g; if ( $conf->exists('echeck-nonus') ) { $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba'; + $payinfo = "$1\@$2"; } else { $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; + $payinfo = "$1\@$2"; } - $payinfo = "$1\@$2"; $self->payinfo($payinfo); $self->paycvv('') if $self->dbdef_table->column('paycvv'); my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - return "Banned ACH account" if $ban; + 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' ) { @@ -1288,9 +1305,12 @@ sub check { } elsif ( $self->payby eq 'COMP' ) { - if ( !$self->custnum && $conf->config('users-allow_comp') ) { + my $curuser = $FS::CurrentUser::CurrentUser; + if ( ! $self->custnum + && ! $curuser->access_right('Complimentary customer') + ) + { return "You are not permitted to create complimentary accounts." - unless grep { $_ eq getotaker } $conf->config('users-allow_comp'); } $error = $self->ut_textn('payinfo'); @@ -1311,7 +1331,7 @@ sub check { } if ( $self->paydate eq '' || $self->paydate eq '-' ) { - return "Expriation date required" + return "Expiration date required" unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/; $self->paydate(''); } else { @@ -1802,29 +1822,26 @@ sub bill { unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) { - my @taxes = qsearch( 'cust_main_county', { - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - 'taxclass' => $part_pkg->taxclass, - } ); + my $prefix = + ( $conf->exists('tax-ship_address') && length($self->ship_last) ) + ? 'ship_' + : ''; + my %taxhash = map { $_ => $self->get("$prefix$_") } + qw( state county country ); + + $taxhash{'taxclass'} = $part_pkg->taxclass; + + my @taxes = qsearch( 'cust_main_county', \%taxhash ); + unless ( @taxes ) { - @taxes = qsearch( 'cust_main_county', { - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - 'taxclass' => '', - } ); + $taxhash{'taxclass'} = ''; + @taxes = qsearch( 'cust_main_county', \%taxhash ); } #one more try at a whole-country tax rate unless ( @taxes ) { - @taxes = qsearch( 'cust_main_county', { - 'state' => '', - 'county' => '', - 'country' => $self->country, - 'taxclass' => '', - } ); + $taxhash{$_} = '' foreach qw( state county ); + @taxes = qsearch( 'cust_main_county', \%taxhash ); } # maybe eliminate this entirely, along with all the 0% records @@ -1832,8 +1849,10 @@ sub bill { $dbh->rollback if $oldAutoCommit; return "fatal: can't find tax rate for state/county/country/taxclass ". - join('/', ( map $self->$_(), qw(state county country) ), - $part_pkg->taxclass ). "\n"; + join('/', ( map $self->get("$prefix$_"), + qw(state county country) + ), + $part_pkg->taxclass ). "\n"; } foreach my $tax ( @taxes ) { @@ -2027,6 +2046,8 @@ quiet - set true to surpress email card/ACH decline notices. freq - "1d" for the traditional, daily events (the default), or "1m" for the new monthly events +payby - allows for one time override of normal customer billing method + =cut sub collect { @@ -2097,7 +2118,10 @@ sub collect { } qsearch( { 'table' => 'part_bill_event', - 'hashref' => { 'payby' => $self->payby, + 'hashref' => { 'payby' => (exists($options{'payby'}) + ? $options{'payby'} + : $self->payby + ), 'disabled' => '', }, 'extra_sql' => $extra_sql, } ) @@ -3124,6 +3148,29 @@ sub balance_date { ); } +=item in_transit_payments + +Returns the total of requests for payments for this customer pending in +batches in transit to the bank. See L and L + +=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 paydate_monthyear Returns a two-element list consisting of the month and year of this customer's @@ -3174,6 +3221,7 @@ This interface may change in the future. sub invoicing_list { my( $self, $arrayref ) = @_; + if ( $arrayref ) { my @cust_main_invoice; if ( $self->custnum ) { @@ -3208,12 +3256,14 @@ sub invoicing_list { warn $error if $error; } } + if ( $self->custnum ) { map { $_->address } qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); } else { (); } + } =item check_invoicing_list ARRAYREF @@ -3291,6 +3341,18 @@ sub invoicing_list_addpost { $self->invoicing_list(\@invoicing_list); } +=item invoicing_list_emailonly + +Returns the list of email invoice recipients (invoicing_list without non-email +destinations such as POST and FAX). + +=cut + +sub invoicing_list_emailonly { + my $self = shift; + grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list; +} + =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ] Returns an array of customers referred by this customer (referral_custnum set @@ -3588,6 +3650,17 @@ sub ship_contact { : $self->contact; } +=item country_full + +Returns this customer's full country name + +=cut + +sub country_full { + my $self = shift; + code2country($self->country); +} + =item status Returns a status string for this customer, currently: @@ -3598,6 +3671,8 @@ Returns a status string for this customer, currently: =item active - One or more recurring packages is active +=item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled) + =item suspended - All non-cancelled recurring packages are suspended =item cancelled - All recurring packages are cancelled @@ -3608,7 +3683,7 @@ Returns a status string for this customer, currently: sub status { my $self = shift; - for my $status (qw( prospect active suspended cancelled )) { + 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; @@ -3623,12 +3698,15 @@ Returns a hex triplet color string for this customer's status. =cut -my %statuscolor = ( - 'prospect' => '000000', - 'active' => '00CC00', - 'suspended' => 'FF9900', - 'cancelled' => 'FF0000', +use vars qw(%statuscolor); +%statuscolor = ( + 'prospect' => '7e0079', #'000000', #black? naw, purple + 'active' => '00CC00', #green + 'inactive' => '0000CC', #blue + 'suspended' => 'FF9900', #yellow + 'cancelled' => 'FF0000', #red ); + sub statuscolor { my $self = shift; $statuscolor{$self->status}; @@ -3647,25 +3725,44 @@ with no packages ever ordered) =cut +use vars qw($select_count_pkgs); +$select_count_pkgs = + "SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum"; + +sub select_count_pkgs_sql { + $select_count_pkgs; +} + sub prospect_sql { " - 0 = ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - ) + 0 = ( $select_count_pkgs ) "; } =item active_sql -Returns an SQL expression identifying active cust_main records. +Returns an SQL expression identifying active cust_main records (customers with +no active recurring packages, but otherwise unsuspended/uncancelled). =cut sub active_sql { " - 0 < ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND ". FS::cust_pkg->active_sql. " + 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) "; } +=item inactive_sql + +Returns an SQL expression identifying inactive cust_main records (customers with +active recurring packages). + +=cut + +sub inactive_sql { " + 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) + AND + 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) +"; } + =item susp_sql =item suspended_sql @@ -3673,23 +3770,12 @@ Returns an SQL expression identifying suspended cust_main records. =cut -#my $recurring_sql = FS::cust_pkg->recurring_sql; -my $recurring_sql = " - '0' != ( select freq from part_pkg - where cust_pkg.pkgpart = part_pkg.pkgpart ) -"; sub suspended_sql { susp_sql(@_); } sub susp_sql { " - 0 < ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND $recurring_sql - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - ) - AND 0 = ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND ". FS::cust_pkg->active_sql. " - ) + 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) + AND + 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) "; } =item cancel_sql @@ -3700,15 +3786,38 @@ Returns an SQL expression identifying cancelled cust_main records. =cut sub cancelled_sql { cancel_sql(@_); } -sub cancel_sql { " - 0 < ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - ) - AND 0 = ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND $recurring_sql - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - ) +sub cancel_sql { + + my $recurring_sql = FS::cust_pkg->recurring_sql; + #my $recurring_sql = " + # '0' != ( select freq from part_pkg + # where cust_pkg.pkgpart = part_pkg.pkgpart ) + #"; + + " + 0 < ( $select_count_pkgs ) + AND 0 = ( $select_count_pkgs AND $recurring_sql + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + ) + "; +} + +=item uncancel_sql +=item uncancelled_sql + +Returns an SQL expression identifying un-cancelled cust_main records. + +=cut + +sub uncancelled_sql { uncancel_sql(@_); } +sub uncancel_sql { " + ( 0 < ( $select_count_pkgs + AND ( cust_pkg.cancel IS NULL + OR cust_pkg.cancel = 0 + ) + ) + OR 0 = ( $select_count_pkgs ) + ) "; } =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ] @@ -3769,15 +3878,27 @@ Returns a (possibly empty) array of FS::cust_main objects. sub smart_search { my %options = @_; my $search = delete $options{'search'}; - my @cust_main = (); + #here is the agent virtualization + my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql; + + my @cust_main = (); if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search - push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } ); + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { 'custnum' => $1, %options }, + 'extra_sql' => " AND $agentnums_sql", #agent virtualization + } ); } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search my $value = lc($1); + + # remove "(Last, First)" in "Company (Last, First"), otherwise the + # full strings the browser remembers won't work + $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name + my $q_value = dbh->quote($value); #exact @@ -3787,54 +3908,73 @@ sub smart_search { if defined dbdef->table('cust_main')->column('ship_last'); $sql .= ' )'; - push @cust_main, qsearch( 'cust_main', \%options, '', $sql ); + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => \%options, + 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization + } ); unless ( @cust_main ) { #no exact match, trying substring/fuzzy #still some false laziness w/ search/cust_main.cgi #substring - push @cust_main, qsearch( 'cust_main', - { 'last' => { 'op' => 'ILIKE', - 'value' => "%$q_value%" }, - %options, - } - ); - push @cust_main, qsearch( 'cust_main', - { 'ship_last' => { 'op' => 'ILIKE', - 'value' => "%$q_value%" }, - %options, - - } - ) + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { 'last' => { 'op' => 'ILIKE', + 'value' => "%$value%" }, + %options, + }, + 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton + } ); + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { 'ship_last' => { 'op' => 'ILIKE', + 'value' => "%$value%" }, + %options, + }, + 'extra_sql' => " AND $agentnums_sql", #agent virtualization + } ) if defined dbdef->table('cust_main')->column('ship_last'); - push @cust_main, qsearch( 'cust_main', - { 'company' => { 'op' => 'ILIKE', - 'value' => "%$q_value%" }, - %options, - } - ); - push @cust_main, qsearch( 'cust_main', - { 'ship_company' => { 'op' => 'ILIKE', - 'value' => "%$q_value%" }, - %options, - } - ) + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { 'company' => { 'op' => 'ILIKE', + 'value' => "%$value%" }, + %options, + }, + 'extra_sql' => " AND $agentnums_sql", #agent virtualization + } ); + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { 'ship_company' => { 'op' => 'ILIKE', + 'value' => "%$value%" }, + %options, + }, + 'extra_sql' => " AND $agentnums_sql", #agent virtualization + } ) if defined dbdef->table('cust_main')->column('ship_last'); #fuzzy push @cust_main, FS::cust_main->fuzzy_search( - { 'last' => $value }, - \%options, + { 'last' => $value }, #fuzzy hashref + \%options, #hashref + '', #select + " AND $agentnums_sql", #extra_sql #agent virtualization ); push @cust_main, FS::cust_main->fuzzy_search( - { 'company' => $value }, - \%options, + { 'company' => $value }, #fuzzy hashref + \%options, #hashref + '', #select + " AND $agentnums_sql", #extra_sql #agent virtualization ); } + #eliminate duplicates + my %saw = (); + @cust_main = grep { !$saw{$_->custnum}++ } @cust_main; + } @cust_main; @@ -3860,6 +4000,7 @@ sub rebuild_fuzzyfiles { use Fcntl qw(:flock); my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + mkdir $dir, 0700 unless -d $dir; #last