X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=7866369d757596aca30dac0479fd9b996d983856;hb=dba94fcedddc2a762bacd478816c41375f3d45e9;hp=8622b87e7e18d6eb38e383903772dfa3d60c9070;hpb=3da06ca40ca237b002337574ad66b697c59d261d;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 8622b87e7..7866369d7 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 ); + $import $skip_fuzzyfiles $ignore_expired_card ); use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; @@ -14,13 +14,15 @@ BEGIN { #eval "use Time::Local qw(timelocal timelocal_nocheck);"; eval "use Time::Local qw(timelocal_nocheck);"; } +use Digest::MD5 qw(md5_base64); use Date::Format; #use Date::Manip; use String::Approx qw(amatch); -use Business::CreditCard; +use Business::CreditCard 0.28; use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearchs qsearch dbdef ); use FS::Misc qw( send_email ); +use FS::Msgcat qw(gettext); use FS::cust_pkg; use FS::cust_svc; use FS::cust_bill; @@ -44,7 +46,7 @@ use FS::cust_tax_exempt; use FS::type_pkgs; use FS::payment_gateway; use FS::agent_payment_gateway; -use FS::Msgcat qw(gettext); +use FS::banned_pay; @ISA = qw( FS::Record ); @@ -52,11 +54,15 @@ use FS::Msgcat qw(gettext); $realtime_bop_decline_quiet = 0; +# 1 is mostly method/subroutine entry and options +# 2 traces progress of some operations +# 3 is even more information including possibly sensitive data $DEBUG = 0; $me = '[FS::cust_main]'; $import = 0; $skip_fuzzyfiles = 0; +$ignore_expired_card = 0; @encrypted_fields = ('payinfo', 'paycvv'); @@ -242,7 +248,7 @@ sub paymask { if ( defined($value) && !$self->is_encrypted($value)) { my $payinfo = $value; my $payby = $self->payby; - if ($payby eq 'CARD' || $payby eq 'DCARD') { # Credit Cards (Show last four) + if ($payby eq 'CARD' || $payby eq 'DCRD') { # Credit Cards (Show last four) $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); } elsif ($payby eq 'CHEK' || $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank) @@ -341,7 +347,7 @@ sub insert { my $cust_pkgs = @_ ? shift : {}; my $invoicing_list = @_ ? shift : ''; my %options = @_; - warn "FS::cust_main::insert called with options ". + warn "$me insert called with options ". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; @@ -358,12 +364,16 @@ sub insert { my $prepay_identifier = ''; my( $amount, $seconds ) = ( 0, 0 ); + my $payby = ''; if ( $self->payby eq 'PREPAY' ) { $self->payby('BILL'); $prepay_identifier = $self->payinfo; $self->payinfo(''); + warn " looking up prepaid card $prepay_identifier\n" + if $DEBUG > 1; + my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -371,8 +381,19 @@ sub insert { return $error; } + $payby = 'PREP' if $amount; + + } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) { + + $payby = $1; + $self->payby('BILL'); + $amount = $self->paid; + } + warn " inserting $self\n" + if $DEBUG > 1; + my $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -380,7 +401,9 @@ sub insert { return $error; } - # invoicing list + warn " setting invoicing list\n" + if $DEBUG > 1; + if ( $invoicing_list ) { $error = $self->check_invoicing_list( $invoicing_list ); if ( $error ) { @@ -390,7 +413,9 @@ sub insert { $self->invoicing_list( $invoicing_list ); } - # packages + warn " ordering packages\n" + if $DEBUG > 1; + $error = $self->order_pkgs($cust_pkgs, \$seconds, %options); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -403,14 +428,18 @@ sub insert { } if ( $amount ) { - $error = $self->insert_cust_pay_prepay($amount, $prepay_identifier); + warn " inserting initial $payby payment of $amount\n" + if $DEBUG > 1; + $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "inserting prepayment (transaction rolled back): $error"; + return "inserting payment (transaction rolled back): $error"; } } unless ( $import || $skip_fuzzyfiles ) { + warn " queueing fuzzyfiles update\n" + if $DEBUG > 1; $error = $self->queue_fuzzyfiles_update; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -418,6 +447,9 @@ sub insert { } } + warn " insert complete; committing transaction\n" + if $DEBUG > 1; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -464,7 +496,7 @@ sub order_pkgs { my %svc_options = (); $svc_options{'depend_jobnum'} = $options{'depend_jobnum'} if exists $options{'depend_jobnum'}; - warn "FS::cust_main::order_pkgs called with options ". + warn "$me order_pkgs called with options ". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; @@ -660,7 +692,7 @@ sub increment_seconds { my $cust_pkg = $cust_pkg[0]; warn " found package pkgnum ". $cust_pkg->pkgnum. "\n" - if $DEBUG; + if $DEBUG > 1; my @cust_svc = $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') ); @@ -674,7 +706,7 @@ sub increment_seconds { my $svc_acct = $cust_svc[0]->svc_x; warn " found service svcnum ". $svc_acct->pkgnum. ' ('. $svc_acct->email. ")\n" - if $DEBUG; + if $DEBUG > 1; $svc_acct->increment_seconds($seconds); @@ -689,14 +721,42 @@ If there is an error, returns the error, otherwise returns false. =cut sub insert_cust_pay_prepay { - my( $self, $amount ) = splice(@_, 0, 2); + shift->insert_cust_pay('PREP', @_); +} + +=item insert_cust_pay_cash AMOUNT [ PAYINFO ] + +Inserts a cash payment in the specified amount for this customer. An optional +second argument can specify the payment identifier for tracking purposes. +If there is an error, returns the error, otherwise returns false. + +=cut + +sub insert_cust_pay_cash { + shift->insert_cust_pay('CASH', @_); +} + +=item insert_cust_pay_west AMOUNT [ PAYINFO ] + +Inserts a Western Union payment in the specified amount for this customer. An +optional second argument can specify the prepayment identifier for tracking +purposes. If there is an error, returns the error, otherwise returns false. + +=cut + +sub insert_cust_pay_west { + shift->insert_cust_pay('WEST', @_); +} + +sub insert_cust_pay { + my( $self, $payby, $amount ) = splice(@_, 0, 3); my $payinfo = scalar(@_) ? shift : ''; my $cust_pay = new FS::cust_pay { 'custnum' => $self->custnum, 'paid' => sprintf('%.2f', $amount), #'_date' => #date the prepaid card was purchased??? - 'payby' => 'PREP', + 'payby' => $payby, 'payinfo' => $payinfo, }; $cust_pay->insert; @@ -717,7 +777,7 @@ otherwise returns false. sub reexport { my $self = shift; - carp "warning: FS::cust_main::reexport is deprectated; ". + 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'; @@ -885,6 +945,11 @@ sub replace { unless grep { $_ eq getotaker } $conf->config('users-allow_comp'); } + local($ignore_expired_card) = 1 + if $old->payby =~ /^(CARD|DCRD)$/ + && $self->payby =~ /^(CARD|DCRD)$/ + && $old->payinfo eq $self->payinfo; + my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -981,7 +1046,8 @@ and replace methods. sub check { my $self = shift; - #warn "BEFORE: \n". $self->_dump; + warn "$me check BEFORE: \n". $self->_dump + if $DEBUG > 2; my $error = $self->ut_numbern('custnum') @@ -1080,7 +1146,7 @@ sub check { } ) ) { return "Unknown ship_state/ship_county/ship_country: ". $self->ship_state. "/". $self->ship_county. "/". $self->ship_country - unless qsearchs('cust_main_county',{ + unless qsearch('cust_main_county',{ 'state' => $self->ship_state, 'county' => $self->ship_county, 'country' => $self->ship_country, @@ -1103,7 +1169,7 @@ sub check { } } - $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/ + $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/ or return "Illegal payby: ". $self->payby; $error = $self->ut_numbern('paystart_month') @@ -1140,8 +1206,13 @@ sub check { $self->payinfo($payinfo); validate($payinfo) or return gettext('invalid_card'); # . ": ". $self->payinfo; + return gettext('unknown_card_type') if cardtype($self->payinfo) eq "Unknown"; + + my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); + return "Banned credit card" if $ban; + if ( defined $self->dbdef_table->column('paycvv') ) { if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { if ( cardtype($self->payinfo) eq 'American Express card' ) { @@ -1191,6 +1262,9 @@ sub check { $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; + } elsif ( $self->payby eq 'LECB' ) { my $payinfo = $self->payinfo; @@ -1232,7 +1306,7 @@ sub check { if ( $self->paydate eq '' || $self->paydate eq '-' ) { return "Expriation date required" - unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/; + unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/; $self->paydate(''); } else { my( $m, $y ); @@ -1246,7 +1320,9 @@ sub check { $self->paydate("$y-$m-01"); my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; return gettext('expired_card') - if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); + if !$import + && !$ignore_expired_card + && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); } if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ && @@ -1265,7 +1341,8 @@ sub check { $self->otaker(getotaker) unless $self->otaker; - #warn "AFTER: \n". $self->_dump; + warn "$me check AFTER: \n". $self->_dump + if $DEBUG > 2; $self->SUPER::check; } @@ -1428,19 +1505,56 @@ sub suspend_unless_pkgpart { Cancels all uncancelled packages (see L) for this customer. -Available options are: I +Available options are: I, I, and I I can be set true to supress email cancellation notices. +# I can be set to a cancellation reason (see L) + +I can be set true to ban this customer's credit card or ACH information, +if present. + Always returns a list: an empty list on success or a list of errors. =cut sub cancel { my $self = shift; + my %opt = @_; + + if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) { + + #should try decryption (we might have the private key) + # and if not maybe queue a job for the server that does? + return ( "Can't (yet) ban encrypted credit cards" ) + if $self->is_encrypted($self->payinfo); + + my $ban = new FS::banned_pay $self->_banned_pay_hashref; + my $error = $ban->insert; + return ( $error ) if $error; + + } + grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs; } +sub _banned_pay_hashref { + my $self = shift; + + my %payby2ban = ( + 'CARD' => 'CARD', + 'DCRD' => 'CARD', + 'CHEK' => 'CHEK', + 'DCHK' => 'CHEK' + ); + + { + 'payby' => $payby2ban{$self->payby}, + 'payinfo' => md5_base64($self->payinfo), + #'reason' => + }; +} + =item agent Returns the agent (see L) for this customer. @@ -1479,7 +1593,8 @@ 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. "\n" if $DEBUG; + warn "$me bill customer ". $self->custnum. "\n" + if $DEBUG; my $time = $options{'time'} || time; @@ -1518,7 +1633,7 @@ sub bill { #NO!! next if $cust_pkg->cancel; next if $cust_pkg->getfield('cancel'); - warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG; + warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1; #? to avoid use of uninitialized value errors... ? $cust_pkg->setfield('bill', '') @@ -1535,7 +1650,7 @@ sub bill { my $setup = 0; if ( !$cust_pkg->setup || $options{'resetup'} ) { - warn " bill setup\n" if $DEBUG; + warn " bill setup\n" if $DEBUG > 1; $setup = eval { $cust_pkg->calc_setup( $time ) }; if ( $@ ) { @@ -1554,7 +1669,7 @@ sub bill { ( $cust_pkg->getfield('bill') || 0 ) <= $time ) { - warn " bill recur\n" if $DEBUG; + warn " bill recur\n" if $DEBUG > 1; # XXX shared with $recur_prog $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; @@ -1586,6 +1701,9 @@ sub bill { } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) { my $days = $1; $mday += $days; + } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) { + my $hours = $1; + $hour += $hours; } else { $dbh->rollback if $oldAutoCommit; return "unparsable frequency: ". $part_pkg->freq; @@ -1600,7 +1718,8 @@ sub bill { if ( $cust_pkg->modified ) { - warn " package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG; + warn " package ". $cust_pkg->pkgnum. " modified; updating\n" + if $DEBUG >1; $error=$cust_pkg->replace($old_cust_pkg); if ( $error ) { #just in case @@ -1620,7 +1739,7 @@ sub bill { } if ( $setup != 0 || $recur != 0 ) { warn " charges (setup=$setup, recur=$recur); queueing line items\n" - if $DEBUG; + if $DEBUG > 1; my $cust_bill_pkg = new FS::cust_bill_pkg ({ 'pkgnum' => $cust_pkg->pkgnum, 'setup' => $setup, @@ -1887,7 +2006,8 @@ sub collect { $self->select_for_update; #mutex my $balance = $self->balance; - warn "collect customer ". $self->custnum. ": balance $balance\n" if $DEBUG; + warn "$me collect customer ". $self->custnum. ": balance $balance\n" + if $DEBUG; unless ( $balance > 0 ) { #redundant????? $dbh->rollback if $oldAutoCommit; #hmm return ''; @@ -1912,8 +2032,8 @@ sub collect { last if $self->balance <= 0; - warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n" - if $DEBUG; + warn " invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n" + if $DEBUG > 1; foreach my $part_bill_event ( sort { $a->seconds <=> $b->seconds @@ -1933,8 +2053,8 @@ sub collect { 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; + warn " calling invoice event (". $part_bill_event->eventcode. ")\n" + if $DEBUG > 1; my $cust_main = $self; #for callback my $error; @@ -2074,7 +2194,7 @@ I can be set true to surpress email decline notices. sub realtime_bop { my( $self, $method, $amount, %options ) = @_; if ( $DEBUG ) { - warn "$self $method $amount\n"; + warn "$me realtime_bop: $method $amount\n"; warn " $_ => $options{$_}\n" foreach keys %options; } @@ -2186,6 +2306,13 @@ sub realtime_bop { : $invoicing_list[0]; my %content = (); + + my $payip = exists($options{'payip'}) + ? $options{'payip'} + : $self->payip; + $content{customer_ip} = $payip + if length($payip); + if ( $method eq 'CC' ) { $content{card_number} = $payinfo; @@ -2195,13 +2322,27 @@ sub realtime_bop { $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; $content{expiration} = "$2/$1"; - if ( defined $self->dbdef_table->column('paycvv') ) { - my $paycvv = exists($options{'paycvv'}) - ? $options{'paycvv'} - : $self->paycvv; - $content{cvv2} = $self->paycvv - if length($paycvv); - } + my $paycvv = exists($options{'paycvv'}) + ? $options{'paycvv'} + : $self->paycvv; + $content{cvv2} = $self->paycvv + if length($paycvv); + + my $paystart_month = exists($options{'paystart_month'}) + ? $options{'paystart_month'} + : $self->paystart_month; + + my $paystart_year = exists($options{'paystart_year'}) + ? $options{'paystart_year'} + : $self->paystart_year; + + $content{card_start} = "$paystart_month/$paystart_year" + if $paystart_month && $paystart_year; + + my $payissue = exists($options{'payissue'}) + ? $options{'payissue'} + : $self->payissue; + $content{issue_number} = $payissue if $payissue; $content{recurring_billing} = 'YES' if qsearch('cust_pay', { 'custnum' => $self->custnum, @@ -2315,7 +2456,7 @@ sub realtime_bop { ) { my $error = $self->remove_cvv; if ( $error ) { - warn "error removing cvv: $error\n"; + warn "WARNING: error removing cvv: $error\n"; } } @@ -2485,7 +2626,7 @@ gateway is attempted. sub realtime_refund_bop { my( $self, $method, %options ) = @_; if ( $DEBUG ) { - warn "$self $method refund\n"; + warn "$me realtime_refund_bop: $method refund\n"; warn " $_ => $options{$_}\n" foreach keys %options; } @@ -2504,12 +2645,12 @@ sub realtime_refund_bop { if ( $options{'paynum'} ) { - warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG; + warn " paynum: $options{paynum}\n" if $DEBUG > 1; $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } ) or return "Unknown paynum $options{'paynum'}"; $amount ||= $cust_pay->paid; - $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):([\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 = ''; @@ -2594,7 +2735,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; + warn " attempting void\n" if $DEBUG > 1; my $void = new Business::OnlinePayment( $processor, @bop_options ); $void->content( 'action' => 'void', %content ); $void->submit(); @@ -2607,13 +2748,13 @@ sub realtime_refund_bop { warn $e; return $e; } - warn "FS::cust_main::realtime_bop: void successful\n" if $DEBUG; + warn " void successful\n" if $DEBUG > 1; return ''; } } - warn "FS::cust_main::realtime_bop: void unsuccessful, trying refund\n" - if $DEBUG; + warn " void unsuccessful, trying refund\n" + if $DEBUG > 1; #massage data my $address = $self->address1;