X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=50cee480333876d6f3c3a3415443fee02f72b546;hp=07f0a34e5975b3da02eb461a2450a4f9e03c98ba;hb=6fe8172b11d0369d0b1274d6825ec0c57afe8001;hpb=3913f6d159b5b8110061690b7c97642c27abf7eb diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 07f0a34e5..50cee4803 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -9,10 +9,12 @@ 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; +use String::Approx qw(amatch); use Business::CreditCard; use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearchs qsearch dbdef ); @@ -21,6 +23,7 @@ use FS::cust_pkg; use FS::cust_bill; use FS::cust_bill_pkg; use FS::cust_pay; +use FS::cust_pay_void; use FS::cust_credit; use FS::cust_refund; use FS::part_referral; @@ -1114,6 +1117,8 @@ If there is an error, returns the error, otherwise returns false. sub bill { my( $self, %options ) = @_; + warn "bill customer ". $self->custnum if $DEBUG; + my $time = $options{'time'} || time; my $error; @@ -1151,14 +1156,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; @@ -1167,27 +1172,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 @@ -1197,28 +1191,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) = @@ -1246,19 +1230,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') ) { @@ -1270,6 +1257,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, @@ -1389,7 +1378,7 @@ sub bill { } #if $setup != 0 || $recur != 0 - } #if $cust_pkg_mod_flag + } #if $cust_pkg->modified } #foreach my $cust_pkg @@ -1536,7 +1525,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 ''; @@ -1734,11 +1723,6 @@ sub realtime_bop { eval "use Business::OnlinePayment"; die $@ if $@; - #overrides - $self->set( $_ => $options{$_} ) - foreach grep { exists($options{$_}) } - qw( payname address1 address2 city state zip payinfo paydate paycvv); - #load up config my $bop_config = 'business-onlinepayment'; $bop_config .= '-ach' @@ -1753,13 +1737,20 @@ sub realtime_bop { #massage data - my $address = $self->address1; - $address .= ", ". $self->address2 if $self->address2; - + my $address = exists($options{'address1'}) + ? $options{'address1'} + : $self->address1; + my $address2 = exists($options{'address2'}) + ? $options{'address2'} + : $self->address2; + $address .= ", ". $address2 if length($address2); + + my $o_payname = exists($options{'payname'}) + ? $options{'payname'} + : $self->payname; my($payname, $payfirst, $paylast); - if ( $self->payname && $method ne 'ECHECK' ) { - $payname = $self->payname; - $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ + if ( $o_payname && $method ne 'ECHECK' ) { + ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ or return "Illegal payname $payname"; ($payfirst, $paylast) = ($1, $2); } else { @@ -1775,41 +1766,53 @@ sub realtime_bop { } my $email = $invoicing_list[0]; - my %content; + my $payinfo = exists($options{'payinfo'}) + ? $options{'payinfo'} + : $self->payinfo; + + my %content = (); if ( $method eq 'CC' ) { - $content{card_number} = $self->payinfo; - $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + $content{card_number} = $payinfo; + my $paydate = exists($options{'paydate'}) + ? $options{'paydate'} + : $self->paydate; + $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 ( defined $self->dbdef_table->column('paycvv') ) { + my $paycvv = exists($options{'paycvv'}) + ? $options{'paycvv'} + : $self->paycvv; + $content{cvv2} = $self->paycvv + if length($paycvv); + } $content{recurring_billing} = 'YES' if qsearch('cust_pay', { 'custnum' => $self->custnum, 'payby' => 'CARD', - 'payinfo' => $self->payinfo, } ); + 'payinfo' => $payinfo, + } ); } elsif ( $method eq 'ECHECK' ) { - my($account_number,$routing_code) = $self->payinfo; ( $content{account_number}, $content{routing_code} ) = - split('@', $self->payinfo); - $content{bank_name} = $self->payname; + split('@', $payinfo); + $content{bank_name} = $o_payname; $content{account_type} = 'CHECKING'; $content{account_name} = $payname; $content{customer_org} = $self->company ? 'B' : 'I'; - $content{customer_ssn} = $self->ss; + $content{customer_ssn} = exists($options{'ss'}) + ? $options{'ss'} + : $self->ss; } elsif ( $method eq 'LEC' ) { - $content{phone} = $self->payinfo; + $content{phone} = $payinfo; } #transaction(s) my( $action1, $action2 ) = split(/\s*\,\s*/, $action ); - my $transaction = - new Business::OnlinePayment( $processor, @bop_options ); + my $transaction = new Business::OnlinePayment( $processor, @bop_options ); $transaction->content( 'type' => $method, 'login' => $login, @@ -1823,10 +1826,18 @@ sub realtime_bop { 'first_name' => $payfirst, 'name' => $payname, 'address' => $address, - 'city' => $self->city, - 'state' => $self->state, - 'zip' => $self->zip, - 'country' => $self->country, + 'city' => ( exists($options{'city'}) + ? $options{'city'} + : $self->city ), + 'state' => ( exists($options{'state'}) + ? $options{'state'} + : $self->state ), + 'zip' => ( exists($options{'zip'}) + ? $options{'zip'} + : $self->zip ), + 'country' => ( exists($options{'country'}) + ? $options{'country'} + : $self->country ), 'referer' => 'http://cleanwhisker.420.am/', 'email' => $email, 'phone' => $self->daytime || $self->night, @@ -1880,12 +1891,9 @@ sub realtime_bop { # correctly if ( defined $self->dbdef_table->column('paycvv') && length($self->paycvv) - && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save') - && ! length($options{'paycvv'}) + && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save') ) { - my $new = new FS::cust_main { $self->hash }; - $new->paycvv(''); - my $error = $new->replace($self); + my $error = $self->remove_cvv; if ( $error ) { warn "error removing cvv: $error\n"; } @@ -1900,14 +1908,19 @@ sub realtime_bop { 'LEC' => 'LECB', ); + my $paybatch = "$processor:". $transaction->authorization; + $paybatch .= ':'. $transaction->order_number + if $transaction->can('order_number') + && length($transaction->order_number); + my $cust_pay = new FS::cust_pay ( { 'custnum' => $self->custnum, 'invnum' => $options{'invnum'}, 'paid' => $amount, '_date' => '', 'payby' => $method2payby{$method}, - 'payinfo' => $self->payinfo, - 'paybatch' => "$processor:". $transaction->authorization, + 'payinfo' => $payinfo, + 'paybatch' => $paybatch, } ); my $error = $cust_pay->insert; if ( $error ) { @@ -1962,6 +1975,242 @@ sub realtime_bop { } +=item remove_cvv + +Removes the I field from the database directly. + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub remove_cvv { + my $self = shift; + my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?") + or return dbh->errstr; + $sth->execute($self->custnum) + or return $sth->errstr; + $self->paycvv(''); + ''; +} + +=item realtime_refund_bop METHOD [ OPTION => VALUE ... ] + +Refunds a realtime credit card, ACH (electronic check) or phone bill transaction +via a Business::OnlinePayment realtime gateway. See +L for supported gateways. + +Available methods are: I, I and I + +Available options are: I, I, I + +Most gateways require a reference to an original payment transaction to refund, +so you probably need to specify a I. + +I defaults to the original amount of the payment if not specified. + +I specifies a reason for the refund. + +Implementation note: If I is unspecified or equal to the amount of the +orignal payment, first an attempt is made to "void" the transaction via +the gateway (to cancel a not-yet settled transaction) and then if that fails, +the normal attempt is made to "refund" ("credit") the transaction via the +gateway is attempted. + +#The additional options I, I, I, I, I, +#I, I and I are also available. Any of these options, +#if set, will override the value from the customer record. + +#If an I is specified, this payment (if sucessful) is applied to the +#specified invoice. If you don't specify an I you might want to +#call the B method. + +=cut + +#some false laziness w/realtime_bop, not enough to make it worth merging +#but some useful small subs should be pulled out +sub realtime_refund_bop { + my( $self, $method, %options ) = @_; + if ( $DEBUG ) { + warn "$self $method refund\n"; + warn " $_ => $options{$_}\n" foreach keys %options; + } + + #pre-requisites + die "Real-time processing not enabled\n" + unless $conf->exists('business-onlinepayment'); + eval "use Business::OnlinePayment"; + die $@ if $@; + + #load up config + my $bop_config = 'business-onlinepayment'; + $bop_config .= '-ach' + if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach'); + my ( $processor, $login, $password, $unused_action, @bop_options ) = + $conf->config($bop_config); + #$action ||= 'normal authorization'; + pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/; + die "No real-time processor is enabled - ". + "did you set the business-onlinepayment configuration value?\n" + unless $processor; + + my $cust_pay = ''; + my $amount = $options{'amount'}; + my( $pay_processor, $auth, $order_number ) = ( '', '', '' ); + if ( $options{'paynum'} ) { + warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG; + $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } ) + or return "Unknown paynum $options{'paynum'}"; + $amount ||= $cust_pay->paid; + $cust_pay->paybatch =~ /^(\w+):(\w*)(:(\w+))?$/ + or return "Can't parse paybatch for paynum $options{'paynum'}: ". + $cust_pay->paybatch; + ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 ); + return "processor of payment $options{'paynum'} $pay_processor does not". + " match current processor $processor" + unless $pay_processor eq $processor; + } + return "neither amount nor paynum specified" unless $amount; + + my %content = ( + 'type' => $method, + 'login' => $login, + 'password' => $password, + 'order_number' => $order_number, + 'amount' => $amount, + 'referer' => 'http://cleanwhisker.420.am/', + ); + $content{authorization} = $auth + if length($auth); #echeck/ACH transactions have an order # but no auth + #(at least with authorize.net) + + #first try void if applicable + if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates? + my $void = new Business::OnlinePayment( $processor, @bop_options ); + $void->content( 'action' => 'void', %content ); + $void->submit(); + if ( $void->is_success ) { + my $error = $cust_pay->void($options{'reason'}); + if ( $error ) { + # gah, even with transactions. + my $e = 'WARNING: Card/ACH voided but database not updated - '. + "error voiding payment: $error"; + warn $e; + return $e; + } + return ''; + } + } + + #massage data + my $address = $self->address1; + $address .= ", ". $self->address2 if $self->address2; + + my($payname, $payfirst, $paylast); + if ( $self->payname && $method ne 'ECHECK' ) { + $payname = $self->payname; + $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ + or return "Illegal payname $payname"; + ($payfirst, $paylast) = ($1, $2); + } else { + $payfirst = $self->getfield('first'); + $paylast = $self->getfield('last'); + $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); + + #$content{recurring_billing} = 'YES' + # if qsearch('cust_pay', { 'custnum' => $self->custnum, + # 'payby' => 'CARD', + # 'payinfo' => $self->payinfo, } ); + + } elsif ( $method eq 'ECHECK' ) { + ( $content{account_number}, $content{routing_code} ) = + split('@', $self->payinfo); + $content{bank_name} = $self->payname; + $content{account_type} = 'CHECKING'; + $content{account_name} = $payname; + $content{customer_org} = $self->company ? 'B' : 'I'; + $content{customer_ssn} = $self->ss; + } elsif ( $method eq 'LEC' ) { + $content{phone} = $self->payinfo; + } + + #then try refund + my $refund = new Business::OnlinePayment( $processor, @bop_options ); + $refund->content( + 'action' => 'credit', + 'customer_id' => $self->custnum, + 'last_name' => $paylast, + 'first_name' => $payfirst, + 'name' => $payname, + 'address' => $address, + 'city' => $self->city, + 'state' => $self->state, + 'zip' => $self->zip, + 'country' => $self->country, + %content, #after + ); + $refund->submit(); + + return "$processor error: ". $refund->error_message + unless $refund->is_success(); + + my %method2payby = ( + 'CC' => 'CARD', + 'ECHECK' => 'CHEK', + 'LEC' => 'LECB', + ); + + my $paybatch = "$processor:". $refund->authorization; + $paybatch .= ':'. $refund->order_number + if $refund->can('order_number') && $refund->order_number; + + while ( $cust_pay && $cust_pay->unappled < $amount ) { + my @cust_bill_pay = $cust_pay->cust_bill_pay; + last unless @cust_bill_pay; + my $cust_bill_pay = pop @cust_bill_pay; + my $error = $cust_bill_pay->delete; + last if $error; + } + + my $cust_refund = new FS::cust_refund ( { + 'custnum' => $self->custnum, + 'paynum' => $options{'paynum'}, + 'refund' => $amount, + '_date' => '', + 'payby' => $method2payby{$method}, + 'payinfo' => $self->payinfo, + 'paybatch' => $paybatch, + 'reason' => $options{'reason'} || 'card or ACH refund', + } ); + my $error = $cust_refund->insert; + if ( $error ) { + $cust_refund->paynum(''); #try again with no specific paynum + my $error2 = $cust_refund->insert; + if ( $error2 ) { + # gah, even with transactions. + my $e = 'WARNING: Card/ACH refunded but database not updated - '. + "error inserting refund ($processor): $error2". + " (previously tried insert with paynum #$options{'paynum'}" . + ": $error )"; + warn $e; + return $e; + } + } + + ''; #no error + +} + =item total_owed Returns the total owed for this customer on all invoices @@ -1995,28 +2244,30 @@ sub total_owed_date { sprintf( "%.2f", $total_bill ); } -=item apply_credits +=item apply_credits OPTION => VALUE ... Applies (see L) unapplied credits (see L) -to outstanding invoice balances in chronological order and returns the value -of any remaining unapplied credits available for refund -(see L). +to outstanding invoice balances in chronological order (or reverse +chronological order if the I option is set to B) and returns the +value of any remaining unapplied credits available for refund (see +L). =cut sub apply_credits { my $self = shift; + my %opt = @_; return 0 unless $self->total_credited; my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 } qsearch('cust_credit', { 'custnum' => $self->custnum } ) ); - my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 } - qsearch('cust_bill', { 'custnum' => $self->custnum } ) ); + my @invoices = $self->open_cust_bill; + @invoices = sort { $b->_date <=> $a->_date } @invoices + if defined($opt{'order'}) && $opt{'order'} eq 'newest'; my $credit; - foreach my $cust_bill ( @invoices ) { my $amount; @@ -2174,7 +2425,7 @@ paydate (credit card expiration date for CARD customers) sub paydate_monthyear { my $self = shift; - if ( $self->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #Pg date format + if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format ( $2, $1 ); } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) { ( $1, $3 ); @@ -2426,9 +2677,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, } ); @@ -2514,6 +2767,19 @@ sub cust_pay { qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) } +=item cust_pay_void + +Returns all voided payments (see L) for this customer. + +=cut + +sub cust_pay_void { + my $self = shift; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } ) +} + + =item cust_refund Returns all the refunds (see L) for this customer. @@ -2668,6 +2934,42 @@ sub cancel_sql { " ) "; } +=item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ] + +Performs a fuzzy (approximate) search and returns the matching FS::cust_main +records. Currently, only I or I may be specified (the +appropriate ship_ field is also searched if applicable). + +Additional options are the same as FS::Record::qsearch + +=cut + +sub fuzzy_search { + my( $self, $fuzzy, $hash, @opt) = @_; + #$self + $hash ||= {}; + my @cust_main = (); + + check_and_rebuild_fuzzyfiles(); + foreach my $field ( keys %$fuzzy ) { + my $sub = \&{"all_$field"}; + my %match = (); + $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) ); + + foreach ( keys %match ) { + push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt); + push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt) + if defined dbdef->table('cust_main')->column('ship_last'); + } + } + + my %saw = (); + @cust_main = grep { !$saw{$_->custnum}++ } @cust_main; + + @cust_main; + +} + =back =head1 SUBROUTINES