X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=fbd461841192e4d1b189555458da4cdf0da3be77;hp=2ee8a42f05a63c6043747c67a03711a5d475a93d;hb=e975ed0585280f4cbb90b02f57114dedc43f58be;hpb=1e9ae4ab4387c8d646476df989e2e92c15ce468d diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 2ee8a42f0..fbd461841 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,7 +1,7 @@ package FS::cust_main; use strict; -use vars qw( @ISA $conf $Debug $import ); +use vars qw( @ISA $conf $DEBUG $import ); use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; @@ -22,6 +22,7 @@ use FS::cust_bill; use FS::cust_bill_pkg; use FS::cust_pay; use FS::cust_credit; +use FS::cust_refund; use FS::part_referral; use FS::cust_main_county; use FS::agent; @@ -41,8 +42,8 @@ use FS::Msgcat qw(gettext); $realtime_bop_decline_quiet = 0; -$Debug = 1; -#$Debug = 1; +$DEBUG = 0; +#$DEBUG = 1; $import = 0; @@ -172,6 +173,8 @@ FS::Record. The following fields are currently supported: =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L) +=item paycvv - Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card + =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy =item payname - name on card or billing name @@ -229,10 +232,16 @@ invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); -Currently available options are: I +Currently available options are: I and I. + +If I is set, all provisioning jobs will have a dependancy +on the supplied jobnum (they will not run until the specific job completes). +This can be used to defer provisioning until some action completes (such +as running the customer's credit card sucessfully). -If I is set true, no provisioning jobs (exports) are scheduled. -(You can schedule them later with the B method.) +The I option is deprecated. If I is set true, no +provisioning jobs (exports) are scheduled. (You can schedule them later with +the B method.) =cut @@ -241,6 +250,9 @@ sub insert { my $cust_pkgs = @_ ? shift : {}; my $invoicing_list = @_ ? shift : ''; my %options = @_; + warn "FS::cust_main::insert called with options ". + join(', ', map { "$_: $options{$_}" } keys %options ). "\n" + if $DEBUG; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -292,8 +304,7 @@ sub insert { } # packages - local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; - $error = $self->order_pkgs($cust_pkgs, \$seconds); + $error = $self->order_pkgs($cust_pkgs, \$seconds, %options); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -327,9 +338,33 @@ sub insert { } -=item order_pkgs +=item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ] -document me. like ->insert(%cust_pkg) on an existing record +Like the insert method on an existing record, this method orders a package +and included services atomicaly. Pass a Tie::RefHash data structure to this +method containing FS::cust_pkg and FS::svc_I objects. There should +be a better explanation of this, but until then, here's an example: + + use Tie::RefHash; + tie %hash, 'Tie::RefHash'; #this part is important + %hash = ( + $cust_pkg => [ $svc_acct ], + ... + ); + $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 ); + +Currently available options are: I and I. + +If I is set, all provisioning jobs will have a dependancy +on the supplied jobnum (they will not run until the specific job completes). +This can be used to defer provisioning until some action completes (such +as running the customer's credit card sucessfully). + +The I option is deprecated. If I is set true, no +provisioning jobs (exports) are scheduled. (You can schedule them later with +the B method for each cust_pkg object. Using the B method +on the cust_main object is not recommended, as existing services will also be +reexported.) =cut @@ -337,6 +372,13 @@ sub order_pkgs { my $self = shift; my $cust_pkgs = shift; my $seconds = shift; + my %options = @_; + my %svc_options = (); + $svc_options{'depend_jobnum'} = $options{'depend_jobnum'} + if exists $options{'depend_jobnum'}; + warn "FS::cust_main::order_pkgs called with options ". + join(', ', map { "$_: $options{$_}" } keys %options ). "\n" + if $DEBUG; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -349,6 +391,8 @@ sub order_pkgs { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; + foreach my $cust_pkg ( keys %$cust_pkgs ) { $cust_pkg->custnum( $self->custnum ); my $error = $cust_pkg->insert; @@ -362,7 +406,7 @@ sub order_pkgs { $svc_something->seconds( $svc_something->seconds + $$seconds ); $$seconds = 0; } - $error = $svc_something->insert; + $error = $svc_something->insert(%svc_options); if ( $error ) { $dbh->rollback if $oldAutoCommit; #return "inserting svc_ (transaction rolled back): $error"; @@ -377,15 +421,21 @@ sub order_pkgs { =item reexport -document me. Re-schedules all exports by calling the B method -of all associated packages (see L). If there is an error, -returns the error; otherwise returns false. +This method is deprecated. See the I option to the insert and +order_pkgs methods for a better way to defer provisioning. + +Re-schedules all exports by calling the B method of all associated +packages (see L). If there is an error, returns the error; +otherwise returns false. =cut sub reexport { my $self = shift; + carp "warning: FS::cust_main::reexport is deprectated; ". + "use the depend_jobnum option to insert or order_pkgs to delay export"; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -444,19 +494,19 @@ sub delete { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) { + if ( $self->cust_bill ) { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with invoices"; } - if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) { + if ( $self->cust_credit ) { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with credits"; } - if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) { + if ( $self->cust_pay ) { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with payments"; } - if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) { + if ( $self->cust_refund ) { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with refunds"; } @@ -773,6 +823,21 @@ sub check { or return gettext('invalid_card'); # . ": ". $self->payinfo; return gettext('unknown_card_type') if cardtype($self->payinfo) eq "Unknown"; + if ( defined $self->dbdef_table->column('paycvv') ) { + if ( length($self->paycvv) ) { + if ( cardtype($self->payinfo) eq 'American Express card' ) { + $self->paycvv =~ /^(\d{4})$/ + or return "CVV2 (CID) for American Express cards is four digits."; + $self->paycvv($1); + } else { + $self->paycvv =~ /^(\d{3})$/ + or return "CVV2 (CVC2/CID) is three digits."; + $self->paycvv($1); + } + } else { + $self->paycvv(''); + } + } } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) { @@ -781,6 +846,7 @@ sub check { $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; $payinfo = "$1\@$2"; $self->payinfo($payinfo); + $self->paycvv('') if $self->dbdef_table->column('paycvv'); } elsif ( $self->payby eq 'LECB' ) { @@ -789,11 +855,13 @@ sub check { $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number'; $payinfo = $1; $self->payinfo($payinfo); + $self->paycvv('') if $self->dbdef_table->column('paycvv'); } elsif ( $self->payby eq 'BILL' ) { $error = $self->ut_textn('payinfo'); return "Illegal P.O. number: ". $self->payinfo if $error; + $self->paycvv('') if $self->dbdef_table->column('paycvv'); } elsif ( $self->payby eq 'COMP' ) { @@ -804,6 +872,7 @@ sub check { $error = $self->ut_textn('payinfo'); return "Illegal comp account issuer: ". $self->payinfo if $error; + $self->paycvv('') if $self->dbdef_table->column('paycvv'); } elsif ( $self->payby eq 'PREPAY' ) { @@ -814,6 +883,7 @@ sub check { return "Illegal prepayment identifier: ". $self->payinfo if $error; return "Unknown prepayment identifier" unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } ); + $self->paycvv('') if $self->dbdef_table->column('paycvv'); } @@ -825,7 +895,7 @@ sub check { my( $m, $y ); if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) { ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" ); - } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) { + } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { ( $m, $y ) = ( $3, "20$2" ); } else { return "Illegal expiration date: ". $self->paydate; @@ -836,7 +906,7 @@ sub check { if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); } - if ( $self->payname eq '' && $self->payby ne 'CHEK' && + if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ && ( ! $conf->exists('require_cardname') || $self->payby !~ /^(CARD|DCRD)$/ ) ) { @@ -850,7 +920,7 @@ sub check { $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax; $self->tax($1); - $self->otaker(getotaker); + $self->otaker(getotaker) unless $self->otaker; #warn "AFTER: \n". $self->_dump; @@ -958,6 +1028,38 @@ sub suspend { grep { $_->suspend } $self->unsuspended_pkgs; } +=item suspend_if_pkgpart PKGPART [ , PKGPART ... ] + +Suspends all unsuspended packages (see L) matching the listed +PKGPARTs (see L). Always returns a list: an empty list on +success or a list of errors. + +=cut + +sub suspend_if_pkgpart { + my $self = shift; + my @pkgparts = @_; + grep { $_->suspend } + grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts } + $self->unsuspended_pkgs; +} + +=item suspend_unless_pkgpart PKGPART [ , PKGPART ... ] + +Suspends all unsuspended packages (see L) unless they match the +listed PKGPARTs (see L). Always returns a list: an empty list +on success or a list of errors. + +=cut + +sub suspend_unless_pkgpart { + my $self = shift; + my @pkgparts = @_; + grep { $_->suspend } + grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts } + $self->unsuspended_pkgs; +} + =item cancel [ OPTION => VALUE ... ] Cancels all uncancelled packages (see L) for this customer. @@ -972,7 +1074,7 @@ Always returns a list: an empty list on success or a list of errors. sub cancel { my $self = shift; - grep { $_->cancel(@_) } $self->ncancelled_pkgs; + grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs; } =item agent @@ -1028,6 +1130,8 @@ sub bill { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + $self->select_for_update; #mutex + # find the packages which are due for billing, find out how much they are # & generate invoice database. @@ -1089,7 +1193,7 @@ sub bill { #bill recurring fee my $recur = 0; my $sdate; - if ( $part_pkg->getfield('freq') > 0 && + if ( $part_pkg->getfield('freq') ne '0' && ! $cust_pkg->getfield('susp') && ( $cust_pkg->getfield('bill') || 0 ) <= $time ) { @@ -1127,8 +1231,19 @@ sub bill { $cust_pkg->last_bill($sdate) if $cust_pkg->dbdef_table->column('last_bill'); - $mon += $part_pkg->freq; - until ( $mon < 12 ) { $mon -= 12; $year++; } + if ( $part_pkg->freq =~ /^\d+$/ ) { + $mon += $part_pkg->freq; + until ( $mon < 12 ) { $mon -= 12; $year++; } + } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) { + my $weeks = $1; + $mday += $weeks * 7; + } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) { + my $days = $1; + $mday += $days; + } else { + $dbh->rollback if $oldAutoCommit; + return "unparsable frequency: ". $part_pkg->freq; + } $cust_pkg->setfield('bill', timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year)); $cust_pkg_mod_flag = 1; @@ -1146,15 +1261,15 @@ sub bill { } $setup = sprintf( "%.2f", $setup ); $recur = sprintf( "%.2f", $recur ); - if ( $setup < 0 ) { + if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) { $dbh->rollback if $oldAutoCommit; return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum; } - if ( $recur < 0 ) { + if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) { $dbh->rollback if $oldAutoCommit; return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum; } - if ( $setup > 0 || $recur > 0 ) { + if ( $setup != 0 || $recur != 0 ) { my $cust_bill_pkg = new FS::cust_bill_pkg ({ 'pkgnum' => $cust_pkg->pkgnum, 'setup' => $setup, @@ -1184,6 +1299,16 @@ sub bill { } ); } + #one more try at a whole-country tax rate + unless ( @taxes ) { + @taxes = qsearch( 'cust_main_county', { + 'state' => '', + 'county' => '', + 'country' => $self->country, + 'taxclass' => '', + } ); + } + # maybe eliminate this entirely, along with all the 0% records unless ( @taxes ) { $dbh->rollback if $oldAutoCommit; @@ -1204,10 +1329,15 @@ sub bill { || $tax->recurtax =~ /^Y$/i; next unless $taxable_charged; - if ( $tax->exempt_amount ) { + if ( $tax->exempt_amount > 0 ) { my ($mon,$year) = (localtime($sdate) )[4,5]; $mon++; my $freq = $part_pkg->freq || 1; + if ( $freq !~ /(\d+)$/ ) { + $dbh->rollback if $oldAutoCommit; + return "daily/weekly package definitions not (yet?)". + " compatible with monthly tax exemptions"; + } my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq ); foreach my $which_month ( 1 .. $freq ) { my %hash = ( @@ -1257,7 +1387,7 @@ sub bill { } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP' - } #if $setup > 0 || $recur > 0 + } #if $setup != 0 || $recur != 0 } #if $cust_pkg_mod_flag @@ -1403,8 +1533,10 @@ sub collect { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + $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 ''; @@ -1422,31 +1554,22 @@ sub collect { } } - foreach my $cust_bill ( $self->cust_bill ) { - - #this has to be before next's - my $amount = sprintf( "%.2f", $balance < $cust_bill->owed - ? $balance - : $cust_bill->owed - ); - $balance = sprintf( "%.2f", $balance - $amount ); - - next unless $cust_bill->owed > 0; + foreach my $cust_bill ( $self->open_cust_bill ) { # don't try to charge for the same invoice if it's already in a batch #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } ); - warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug; - - next unless $amount > 0; + last if $self->balance <= 0; + warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")" + if $DEBUG; foreach my $part_bill_event ( sort { $a->seconds <=> $b->seconds || $a->weight <=> $b->weight || $a->eventpart <=> $b->eventpart } grep { $_->seconds <= ( $invoice_time - $cust_bill->_date ) - && ! qsearchs( 'cust_bill_event', { + && ! qsearch( 'cust_bill_event', { 'invnum' => $cust_bill->invnum, 'eventpart' => $_->eventpart, 'status' => 'done', @@ -1456,10 +1579,11 @@ sub collect { 'disabled' => '', } ) ) { - last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0 + last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0 + || $self->balance <= 0; # or if balance<=0 warn "calling invoice event (". $part_bill_event->eventcode. ")\n" - if $Debug; + if $DEBUG; my $cust_main = $self; #for callback my $error; @@ -1597,7 +1721,7 @@ I can be set true to surpress email decline notices. sub realtime_bop { my( $self, $method, $amount, %options ) = @_; - if ( $Debug ) { + if ( $DEBUG ) { warn "$self $method $amount\n"; warn " $_ => $options{$_}\n" foreach keys %options; } @@ -1613,7 +1737,7 @@ sub realtime_bop { #overrides $self->set( $_ => $options{$_} ) foreach grep { exists($options{$_}) } - qw( payname address1 address2 city state zip payinfo paydate ); + qw( payname address1 address2 city state zip payinfo paydate paycvv); #load up config my $bop_config = 'business-onlinepayment'; @@ -1623,6 +1747,9 @@ sub realtime_bop { $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; #massage data @@ -1650,9 +1777,20 @@ sub realtime_bop { my %content; 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' ) { my($account_number,$routing_code) = $self->payinfo; ( $content{account_number}, $content{routing_code} ) = @@ -1737,6 +1875,22 @@ sub realtime_bop { } + #remove paycvv after initial transaction + #false laziness w/misc/process/payment.cgi - check both to make sure working + # correctly + if ( defined $self->dbdef_table->column('paycvv') + && length($self->paycvv) + && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save') + && ! length($options{'paycvv'}) + ) { + my $new = new FS::cust_main { $self->hash }; + $new->paycvv(''); + my $error = $new->replace($self); + if ( $error ) { + warn "error removing cvv: $error\n"; + } + } + #result handling if ( $transaction->is_success() ) { @@ -1757,15 +1911,19 @@ sub realtime_bop { } ); my $error = $cust_pay->insert; if ( $error ) { - # gah, even with transactions. - my $e = 'WARNING: Card/ACH debited but database not updated - '. - 'error applying payment, invnum #' . $self->invnum. - " ($processor): $error"; - warn $e; - return $e; - } else { - return ''; + $cust_pay->invnum(''); #try again with no specific invnum + my $error2 = $cust_pay->insert; + if ( $error2 ) { + # gah, even with transactions. + my $e = 'WARNING: Card/ACH debited but database not updated - '. + "error inserting payment ($processor): $error2". + " (previously tried insert with invnum #$options{'invnum'}" . + ": $error )"; + warn $e; + return $e; + } } + return ''; #no error } else { @@ -1774,7 +1932,7 @@ sub realtime_bop { if ( !$options{'quiet'} && !$realtime_bop_decline_quiet && $conf->exists('emaildecline') && grep { $_ ne 'POST' } $self->invoicing_list - && ! grep { $_ eq $transaction->error_message } + && ! grep { $transaction->error_message =~ /$_/ } $conf->config('emaildecline-exclude') ) { my @templ = $conf->config('declinetemplate'); @@ -2007,6 +2165,37 @@ sub balance_date { ); } +=item paydate_monthyear + +Returns a two-element list consisting of the month and year of this customer's +paydate (credit card expiration date for CARD customers) + +=cut + +sub paydate_monthyear { + my $self = shift; + if ( $self->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #Pg date format + ( $2, $1 ); + } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) { + ( $1, $3 ); + } else { + ('', ''); + } +} + +=item payinfo_masked + +Returns a "masked" payinfo field with all but the last four characters replaced +by 'x'es. Useful for displaying credit cards. + +=cut + +sub payinfo_masked { + my $self = shift; + my $payinfo = $self->payinfo; + 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); +} + =item invoicing_list [ ARRAYREF ] If an arguement is given, sets these email addresses as invoice recipients @@ -2301,6 +2490,54 @@ sub open_cust_bill { grep { $_->owed > 0 } $self->cust_bill; } +=item cust_credit + +Returns all the credits (see L) for this customer. + +=cut + +sub cust_credit { + my $self = shift; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) +} + +=item cust_pay + +Returns all the payments (see L) for this customer. + +=cut + +sub cust_pay { + my $self = shift; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) +} + +=item cust_refund + +Returns all the refunds (see L) for this customer. + +=cut + +sub cust_refund { + my $self = shift; + sort { $a->_date <=> $b->_date } + 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' ); +} + =back =head1 SUBROUTINES @@ -2491,7 +2728,7 @@ sub batch_import { my %cust_main = ( agentnum => $agentnum, refnum => $refnum, - country => 'US', #default + country => $conf->config('countrydefault') || 'US', payby => 'BILL', #default paydate => '12/2037', #default ); @@ -2652,6 +2889,8 @@ card types. No multiple currency support (probably a larger project than just this module). +payinfo_masked false laziness with cust_pay.pm and cust_refund.pm + =head1 SEE ALSO L, L, L, L