X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=479b19a4acc278e1e3fefcec4f2acf2fb5342e44;hb=c62991706722410987b249893f1323b4ba0e7a5f;hp=075cce325096f331d3e332220f858aabcc0ed8e4;hpb=19826b5e1b5a7c8429fb1b2991b0d938a08f51de;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 075cce325..479b19a4a 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,15 +1,17 @@ package FS::cust_main; use strict; -use vars qw( @ISA $conf $DEBUG $import ); +use vars qw( @ISA @EXPORT_OK $conf $DEBUG $import ); use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; +use Exporter; BEGIN { eval "use Time::Local;"; die "Time::Local minimum version 1.05 required with Perl versions before 5.6" if $] < 5.006 && !defined($Time::Local::VERSION); - eval "use Time::Local qw(timelocal timelocal_nocheck);"; + #eval "use Time::Local qw(timelocal timelocal_nocheck);"; + eval "use Time::Local qw(timelocal_nocheck);"; } use Date::Format; #use Date::Manip; @@ -42,6 +44,8 @@ use FS::Msgcat qw(gettext); @ISA = qw( FS::Record ); +@EXPORT_OK = qw( smart_search ); + $realtime_bop_decline_quiet = 0; $DEBUG = 0; @@ -171,7 +175,7 @@ FS::Record. The following fields are currently supported: =item ship_fax - phone (optional) -=item payby - I (credit card - automatic), I (credit card - on-demand), I (electronic check - automatic), I (electronic check - on-demand), I (Phone bill billing), I (billing), I (free), or I (special billing type: applies a credit - see L and sets billing type to I) +=item payby - I (credit card - automatic), I (credit card - on-demand), I (electronic check - automatic), I (electronic check - on-demand), I (Phone bill billing), I (billing), I (free), or I (special billing type: applies a payment from a prepaid card - see L - and sets billing type to I) =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L) @@ -267,20 +271,28 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $amount = 0; + my $prepay_credit = ''; my $seconds = 0; if ( $self->payby eq 'PREPAY' ) { $self->payby('BILL'); - my $prepay_credit = qsearchs( + $prepay_credit = qsearchs( 'prepay_credit', { 'identifier' => $self->payinfo }, '', 'FOR UPDATE' ); - warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo - unless $prepay_credit; - $amount = $prepay_credit->amount; + unless ( $prepay_credit ) { + $dbh->rollback if $oldAutoCommit; + return "Invalid prepaid card: ". $self->payinfo; + } $seconds = $prepay_credit->seconds; + if ( $prepay_credit->agentnum ) { + if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) { + $dbh->rollback if $oldAutoCommit; + return "prepaid card not valid for agent ". $self->agentnum; + } + $self->agentnum($prepay_credit->agentnum); + } my $error = $prepay_credit->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -317,15 +329,18 @@ sub insert { return "No svc_acct record to apply pre-paid time"; } - if ( $amount ) { - my $cust_credit = new FS::cust_credit { + if ( $prepay_credit && $prepay_credit->amount ) { + my $cust_pay = new FS::cust_pay { 'custnum' => $self->custnum, - 'amount' => $amount, + 'paid' => $prepay_credit->amount, + #'_date' => #date the prepaid card was purchased??? + 'payby' => 'PREP', + 'payinfo' => $prepay_credit->identifier, }; - $error = $cust_credit->insert; + $error = $cust_pay->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "inserting credit (transaction rolled back): $error"; + return "inserting prepayment (transaction rolled back): $error"; } } @@ -1005,6 +1020,27 @@ sub unsuspended_pkgs { grep { ! $_->susp } $self->ncancelled_pkgs; } +=item num_cancelled_pkgs + +Returns the number of cancelled packages (see L) for this +customer. + +=cut + +sub num_cancelled_pkgs { + my $self = shift; + $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0"); +} + +sub num_pkgs { + my( $self, $sql ) = @_; + my $sth = dbh->prepare( + "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql" + ) or die dbh->errstr; + $sth->execute($self->custnum) or die $sth->errstr; + $sth->fetchrow_arrayref->[0]; +} + =item unsuspend Unsuspends all unflagged suspended packages (see L @@ -1116,6 +1152,9 @@ If there is an error, returns the error, otherwise returns false. sub bill { my( $self, %options ) = @_; + return '' if $self->payby eq 'COMP'; + warn "bill customer ". $self->custnum if $DEBUG; + my $time = $options{'time'} || time; my $error; @@ -1153,14 +1192,14 @@ sub bill { #NO!! next if $cust_pkg->cancel; next if $cust_pkg->getfield('cancel'); + warn " bill package ". $cust_pkg->pkgnum if $DEBUG; + #? to avoid use of uninitialized value errors... ? $cust_pkg->setfield('bill', '') unless defined($cust_pkg->bill); my $part_pkg = $cust_pkg->part_pkg; - #so we don't modify cust_pkg record unnecessarily - my $cust_pkg_mod_flag = 0; my %hash = $cust_pkg->hash; my $old_cust_pkg = new FS::cust_pkg \%hash; @@ -1169,27 +1208,16 @@ sub bill { # bill setup my $setup = 0; if ( !$cust_pkg->setup || $options{'resetup'} ) { - my $setup_prog = $part_pkg->getfield('setup'); - $setup_prog =~ /^(.*)$/ or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal setup for pkgpart ". $part_pkg->pkgpart. - ": $setup_prog"; - }; - $setup_prog = $1; - $setup_prog = '0' if $setup_prog =~ /^\s*$/; - - #my $cpt = new Safe; - ##$cpt->permit(); #what is necessary? - #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? - #$setup = $cpt->reval($setup_prog); - $setup = eval $setup_prog; - unless ( defined($setup) ) { + + warn " bill setup" if $DEBUG; + + $setup = eval { $cust_pkg->calc_setup( $time ) }; + if ( $@ ) { $dbh->rollback if $oldAutoCommit; - return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart. - "(expression $setup_prog): $@"; + return $@; } + $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup; - $cust_pkg_mod_flag=1; } #bill recurring fee @@ -1199,28 +1227,18 @@ sub bill { ! $cust_pkg->getfield('susp') && ( $cust_pkg->getfield('bill') || 0 ) <= $time ) { - my $recur_prog = $part_pkg->getfield('recur'); - $recur_prog =~ /^(.*)$/ or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal recur for pkgpart ". $part_pkg->pkgpart. - ": $recur_prog"; - }; - $recur_prog = $1; - $recur_prog = '0' if $recur_prog =~ /^\s*$/; - # shared with $recur_prog + warn " bill recur" if $DEBUG; + + # XXX shared with $recur_prog $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; - #my $cpt = new Safe; - ##$cpt->permit(); #what is necessary? - #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? - #$recur = $cpt->reval($recur_prog); - $recur = eval $recur_prog; - unless ( defined($recur) ) { + $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) }; + if ( $@ ) { $dbh->rollback if $oldAutoCommit; - return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart. - "(expression $recur_prog): $@"; + return $@; } + #change this bit to use Date::Manip? CAREFUL with timezones (see # mailing list archive) my ($sec,$min,$hour,$mday,$mon,$year) = @@ -1248,19 +1266,22 @@ sub bill { } $cust_pkg->setfield('bill', timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year)); - $cust_pkg_mod_flag = 1; } warn "\$setup is undefined" unless defined($setup); warn "\$recur is undefined" unless defined($recur); warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill); - if ( $cust_pkg_mod_flag ) { + if ( $cust_pkg->modified ) { + + warn " package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG; + $error=$cust_pkg->replace($old_cust_pkg); if ( $error ) { #just in case $dbh->rollback if $oldAutoCommit; return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"; } + $setup = sprintf( "%.2f", $setup ); $recur = sprintf( "%.2f", $recur ); if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) { @@ -1272,6 +1293,8 @@ sub bill { return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum; } if ( $setup != 0 || $recur != 0 ) { + warn " charges (setup=$setup, recur=$recur); queueing line items\n" + if $DEBUG; my $cust_bill_pkg = new FS::cust_bill_pkg ({ 'pkgnum' => $cust_pkg->pkgnum, 'setup' => $setup, @@ -1331,7 +1354,7 @@ sub bill { || $tax->recurtax =~ /^Y$/i; next unless $taxable_charged; - if ( $tax->exempt_amount > 0 ) { + if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) { my ($mon,$year) = (localtime($sdate) )[4,5]; $mon++; my $freq = $part_pkg->freq || 1; @@ -1391,7 +1414,7 @@ sub bill { } #if $setup != 0 || $recur != 0 - } #if $cust_pkg_mod_flag + } #if $cust_pkg->modified } #foreach my $cust_pkg @@ -1538,7 +1561,7 @@ sub collect { $self->select_for_update; #mutex my $balance = $self->balance; - warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG; + warn "collect customer ". $self->custnum. ": balance $balance" if $DEBUG; unless ( $balance > 0 ) { #redundant????? $dbh->rollback if $oldAutoCommit; #hmm return ''; @@ -1591,6 +1614,7 @@ sub collect { my $error; { local $realtime_bop_decline_quiet = 1 if $options{'quiet'}; + local $SIG{__DIE__}; # don't want Mason __DIE__ handler active $error = eval $part_bill_event->eventcode; } @@ -2098,6 +2122,7 @@ sub realtime_refund_bop { #first try void if applicable if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates? + warn "FS::cust_main::realtime_bop: attempting void\n" if $DEBUG; my $void = new Business::OnlinePayment( $processor, @bop_options ); $void->content( 'action' => 'void', %content ); $void->submit(); @@ -2110,10 +2135,14 @@ sub realtime_refund_bop { warn $e; return $e; } + warn "FS::cust_main::realtime_bop: void successful\n" if $DEBUG; return ''; } } + warn "FS::cust_main::realtime_bop: void unsuccessful, trying refund\n" + if $DEBUG; + #massage data my $address = $self->address1; $address .= ", ". $self->address2 if $self->address2; @@ -2130,20 +2159,17 @@ sub realtime_refund_bop { $payname = "$payfirst $paylast"; } - if ( $method eq 'CC' ) { - - $content{card_number} = $self->payinfo; - $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - $content{expiration} = "$2/$1"; - - #$content{cvv2} = $self->paycvv - # if defined $self->dbdef_table->column('paycvv') - # && length($self->paycvv); + if ( $method eq 'CC' ) { - #$content{recurring_billing} = 'YES' - # if qsearch('cust_pay', { 'custnum' => $self->custnum, - # 'payby' => 'CARD', - # 'payinfo' => $self->payinfo, } ); + if ( $cust_pay ) { + $content{card_number} = $cust_pay->payinfo; + #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + #$content{expiration} = "$2/$1"; + } else { + $content{card_number} = $self->payinfo; + $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + $content{expiration} = "$2/$1"; + } } elsif ( $method eq 'ECHECK' ) { ( $content{account_number}, $content{routing_code} ) = @@ -2159,7 +2185,7 @@ sub realtime_refund_bop { #then try refund my $refund = new Business::OnlinePayment( $processor, @bop_options ); - $refund->content( + my %sub_content = $refund->content( 'action' => 'credit', 'customer_id' => $self->custnum, 'last_name' => $paylast, @@ -2172,6 +2198,8 @@ sub realtime_refund_bop { 'country' => $self->country, %content, #after ); + warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content ) + if $DEBUG > 1; $refund->submit(); return "$processor error: ". $refund->error_message @@ -2646,6 +2674,19 @@ sub referral_cust_pkg { $self->referral_cust_main($depth); } +=item referring_cust_main + +Returns the single cust_main record for the customer who referred this customer +(referral_custnum), or false. + +=cut + +sub referring_cust_main { + my $self = shift; + return '' unless $self->referral_custnum; + qsearchs('cust_main', { 'custnum' => $self->referral_custnum } ); +} + =item credit AMOUNT, REASON Applies a credit to this customer. If there is an error, returns the error, @@ -2690,9 +2731,11 @@ sub charge { my $part_pkg = new FS::part_pkg ( { 'pkg' => $pkg, 'comment' => $comment, - 'setup' => $amount, + #'setup' => $amount, + #'recur' => '0', + 'plan' => 'flat', + 'plandata' => "setup_fee=$amount", 'freq' => 0, - 'recur' => '0', 'disabled' => 'Y', 'taxclass' => $taxclass, } ); @@ -2924,6 +2967,7 @@ sub susp_sql { " AND 0 = ( SELECT COUNT(*) FROM cust_pkg WHERE cust_pkg.custnum = cust_main.custnum AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) ) "; } @@ -2987,6 +3031,94 @@ sub fuzzy_search { =over 4 +=item smart_search OPTION => VALUE ... + +Accepts the following options: I, the string to search for. The string +will be searched for as a customer number, last name or company name, first +searching for an exact match then fuzzy and substring matches. + +Any additional options treated as an additional qualifier on the search +(i.e. I). + +Returns a (possibly empty) array of FS::cust_main objects. + +=cut + +sub smart_search { + my %options = @_; + my $search = delete $options{'search'}; + my @cust_main = (); + + if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search + + push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } ); + + } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search + + my $value = lc($1); + my $q_value = dbh->quote($value); + + #exact + my $sql = scalar(keys %options) ? ' AND ' : ' WHERE '; + $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value"; + $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value" + if defined dbdef->table('cust_main')->column('ship_last'); + $sql .= ' )'; + + push @cust_main, qsearch( 'cust_main', \%options, '', $sql ); + + 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, + + } + ) + 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, + } + ) + if defined dbdef->table('cust_main')->column('ship_last'); + + #fuzzy + push @cust_main, FS::cust_main->fuzzy_search( + { 'last' => $value }, + \%options, + ); + push @cust_main, FS::cust_main->fuzzy_search( + { 'company' => $value }, + \%options, + ); + + } + + } + + @cust_main; + +} + =item check_and_rebuild_fuzzyfiles =cut