X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=ff75eb63d177541cf1663a0906875b32c89e4dae;hb=fcce61390d750f98bd82e84d4664ae9c03202be2;hp=cd8f57356c075a2a0ea40f54288f28fdf3641b58;hpb=00277822362dc6b54f9ba8276ff05cbb55bc90d0;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index cd8f57356..ff75eb63d 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -34,6 +34,7 @@ use Date::Format; use File::Temp; #qw( tempfile ); use Email::Address; use Business::CreditCard 0.28; +use Try::Tiny; use FS::UID qw( getotaker dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); use FS::Misc qw( generate_email send_email generate_ps do_print money_pretty card_types ); @@ -77,6 +78,7 @@ use FS::contact; use FS::Locales; use FS::upgrade_journal; use FS::reason; +use FS::DBI; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -266,7 +268,7 @@ Enable individual CDR spooling, empty or `Y' =item dundate -A suggestion to events (see L) to delay until this unix timestamp +A suggestion to events (see L) to delay until this unix timestamp =item squelch_cdr @@ -1211,7 +1213,7 @@ sub delete { $ticket_dbh = $dbh; } elsif ($conf->config('ticket_system') eq 'RT_External') { my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc'); - $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 }); + $ticket_dbh = FS::DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 }); #or die "RT_External DBI->connect error: $DBI::errstr\n"; } @@ -1457,7 +1459,7 @@ sub merge { $ticket_dbh = $dbh; } elsif ($conf->config('ticket_system') eq 'RT_External') { my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc'); - $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 }); + $ticket_dbh = FS::DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 }); #or die "RT_External DBI->connect error: $DBI::errstr\n"; } @@ -1968,7 +1970,19 @@ sub check { validate($payinfo) or return gettext('invalid_card'); # . ": ". $self->payinfo; - my $cardtype = cardtype($payinfo); + my $cardtype = $self->paycardtype; + if ( $payinfo =~ /^99\d{14}$/ ) { + $self->set('is_tokenized', 'Y'); #so we don't try to do it again + if ( $self->paymask =~ /^\d+x/ ) { + $cardtype = cardtype($self->paymask); + } else { + #return "paycardtype required ". + # "(can't derive from a token and no paymask w/prefix provided)" + # unless $cardtype; + } + } else { + $cardtype = cardtype($self->payinfo); + } return gettext('unknown_card_type') if $cardtype eq 'Unknown'; @@ -2133,6 +2147,10 @@ sub check { if !$import && !$ignore_expired_card && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); + + if ( my $error = $self->ut_daten('paydate') ) { + return $error; + } } if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ && @@ -2287,7 +2305,7 @@ Returns a list: an empty list on success or a list of errors. sub unsuspend { my $self = shift; - grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs; + grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs(@_); } =item release_hold @@ -2416,7 +2434,7 @@ FS::cust_pkg::cancel() methods. =item quiet - can be set true to supress email cancellation notices. -=item reason - can be set to a cancellation reason (see L), either a +=item reason - can be set to a cancellation reason (see L), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L) @@ -2479,10 +2497,9 @@ sub cancel_pkgs { } dbh->commit; - $FS::UID::AutoCommit = 1; my @errors; - # now cancel all services, the same way we would for individual packages. - # if any of them fail, cancel the rest anyway. + # try to cancel each service, the same way we would for individual packages, + # but in cancel weight order. my @cust_svc = map { $_->cust_svc } @pkgs; my @sorted_cust_svc = map { $_->[0] } @@ -2495,8 +2512,15 @@ sub cancel_pkgs { foreach my $cust_svc (@sorted_cust_svc) { my $part_svc = $cust_svc->part_svc; next if ( defined($part_svc) and $part_svc->preserve ); - my $error = $cust_svc->cancel; # immediate cancel, no date option - push @errors, $error if $error; + # immediate cancel, no date option + # transactionize individually + my $error = try { $cust_svc->cancel } catch { $_ }; + if ( $error ) { + dbh->rollback; + push @errors, $error; + } else { + dbh->commit; + } } if (@errors) { return @errors; @@ -2524,7 +2548,12 @@ sub cancel_pkgs { } } my $error = $_->cancel(%lopt); - push @errors, 'pkgnum '.$_->pkgnum.': '.$error if $error; + if ( $error ) { + dbh->rollback; + push @errors, 'pkgnum '.$_->pkgnum.': '.$error; + } else { + dbh->commit; + } } return @errors; @@ -2778,7 +2807,7 @@ sub batch_card { } ); foreach (qw( address1 address2 city state zip country latitude longitude - payby payinfo paydate payname )) + payby payinfo paydate payname paycode paytype )) { $options{$_} = '' unless exists($options{$_}); } @@ -2802,9 +2831,15 @@ sub batch_card { 'country' => $options{country} || $loc->country, 'payby' => $options{payby} || $self->payby, 'payinfo' => $options{payinfo} || $self->payinfo, + 'paymask' => ( $options{payinfo} + ? FS::payinfo_Mixin->mask_payinfo( $options{payby}, + $options{payinfo} ) + : $self->paymask + ), 'exp' => $options{paydate} || $self->paydate, 'payname' => $options{payname} || $self->payname, 'amount' => $amount, # consolidating + 'paycode' => $options{paycode} || '', } ); $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum) @@ -2822,6 +2857,62 @@ sub batch_card { die $error; } + if ($options{'processing-fee'} > 0) { + my $pf_cust_pkg; + my $processing_fee_text = 'Payment Processing Fee'; + + unless ( $invnum ) { # probably from a payment screen + # do we have any open invoices? pick earliest + # uses the fact that cust_main->cust_bill sorts by date ascending + my @open = $self->open_cust_bill; + $invnum = $open[0]->invnum if scalar(@open); + } + + unless ( $invnum ) { # still nothing? pick last closed invoice + # again uses fact that cust_main->cust_bill sorts by date ascending + my @closed = $self->cust_bill; + $invnum = $closed[$#closed]->invnum if scalar(@closed); + } + + unless ( $invnum ) { + # XXX: unlikely case - pre-paying before any invoices generated + # what it should do is create a new invoice and pick it + warn '\PROCESS FEE AND NO INVOICES PICKED TO APPLY IT!'; + return ''; + } + + my $pf_change_error = $self->charge({ + 'amount' => $options{'processing-fee'}, + 'pkg' => $processing_fee_text, + 'setuptax' => 'Y', + 'cust_pkg_ref' => \$pf_cust_pkg, + }); + + if($pf_change_error) { + warn 'Unable to add payment processing fee'; + return ''; + } + + $pf_cust_pkg->setup(time); + my $pf_error = $pf_cust_pkg->replace; + if($pf_error) { + warn 'Unable to set setup time on cust_pkg for processing fee'; + # but keep going... + } + + my $cust_bill = qsearchs('cust_bill', { 'invnum' => $invnum }); + unless ( $cust_bill ) { + warn "race condition + invoice deletion just happened"; + return ''; + } + + my $grand_pf_error = + $cust_bill->add_cc_surcharge($pf_cust_pkg->pkgnum,$options{'processing-fee'}); + + warn "cannot add Processing fee to invoice #$invnum: $grand_pf_error" + if $grand_pf_error; + } + my $unapplied = $self->total_unapplied_credits + $self->total_unapplied_payments + $self->in_transit_payments; @@ -3083,7 +3174,7 @@ UNIX timestamps; see L). Also see L and L for conversion functions. The empty string can be passed to disable that time constraint completely. -Accepts the same options as L: +Accepts the same options as L: =over 4 @@ -5167,121 +5258,6 @@ sub search { =over 4 -=item batch_charge - -=cut - -sub batch_charge { - my $param = shift; - #warn join('-',keys %$param); - my $fh = $param->{filehandle}; - my $agentnum = $param->{agentnum}; - my $format = $param->{format}; - - my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql; - - my @fields; - if ( $format eq 'simple' ) { - @fields = qw( custnum agent_custid amount pkg ); - } else { - die "unknown format $format"; - } - - eval "use Text::CSV_XS;"; - die $@ if $@; - - my $csv = new Text::CSV_XS; - #warn $csv; - #warn $fh; - - my $imported = 0; - #my $columns; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - #while ( $columns = $csv->getline($fh) ) { - my $line; - while ( defined($line=<$fh>) ) { - - $csv->parse($line) or do { - $dbh->rollback if $oldAutoCommit; - return "can't parse: ". $csv->error_input(); - }; - - my @columns = $csv->fields(); - #warn join('-',@columns); - - my %row = (); - foreach my $field ( @fields ) { - $row{$field} = shift @columns; - } - - if ( $row{custnum} && $row{agent_custid} ) { - dbh->rollback if $oldAutoCommit; - return "can't specify custnum with agent_custid $row{agent_custid}"; - } - - my %hash = (); - if ( $row{agent_custid} && $agentnum ) { - %hash = ( 'agent_custid' => $row{agent_custid}, - 'agentnum' => $agentnum, - ); - } - - if ( $row{custnum} ) { - %hash = ( 'custnum' => $row{custnum} ); - } - - unless ( scalar(keys %hash) ) { - $dbh->rollback if $oldAutoCommit; - return "can't find customer without custnum or agent_custid and agentnum"; - } - - my $cust_main = qsearchs('cust_main', { %hash } ); - unless ( $cust_main ) { - $dbh->rollback if $oldAutoCommit; - my $custnum = $row{custnum} || $row{agent_custid}; - return "unknown custnum $custnum"; - } - - if ( $row{'amount'} > 0 ) { - my $error = $cust_main->charge($row{'amount'}, $row{'pkg'}); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $imported++; - } elsif ( $row{'amount'} < 0 ) { - my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ), - $row{'pkg'} ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $imported++; - } else { - #hmm? - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - return "Empty file!" unless $imported; - - ''; #no error - -} - =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS Deprecated. Use event notification and message templates @@ -5740,8 +5716,86 @@ sub _upgrade_data { #class method FS::Setup::enable_encryption(); } + $class->_upgrade_data_paydate_edgebug; } +=item _upgrade_data_paydate_edgebug + +Correct bad data injected into payment expire date column by Edge browser bug + +The month and year values may have an extra character injected into form POST +data by Edge browser. It was possible for some bad month values to slip +past data validation. + +If the stored value was out of range, it was causing payments screen to crash. +We can detect and fix this by dropping the second digit. + +If the stored value is is 11 or 12, it's possible the user inputted a 1. In +this case, the payment method will fail to authorize, but the record will +not cause crashdumps for being out of range. + +In short, check for any expiration month > 12, and drop the extra digit + +=cut + +sub _upgrade_data_paydate_edgebug { + my $journal_label = 'cust_main_paydate_edgebug'; + return if FS::upgrade_journal->is_done( $journal_label ); + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + + for my $row ( + FS::Record::qsearch( + cust_main => { paydate => { op => '!=', value => '' }} + ) + ) { + next unless $row->ut_daten('paydate'); + + # paydate column stored in database has failed date validation + my $bad_paydate = $row->paydate; + + my @date = split /[\-\/]/, $bad_paydate; + @date = @date[2,0,1] if $date[2] > 1900; + + # Only autocorrecting when month > 12 - notify operator + unless ( $date[1] > 12 ) { + die sprintf( + 'Unable to correct bad paydate stored in cust_main row '. + 'custnum(%s) paydate(%s)', + $row->custnum, + $bad_paydate, + ); + } + + $date[1] = substr( $date[1], 0, 1 ); + $row->paydate( join('-', @date )); + + if ( my $error = $row->replace ) { + die sprintf( + 'Failed to autocorrect bad paydate stored in cust_main row '. + 'custnum(%s) paydate(%s) - error: %s', + $row->custnum, + $bad_paydate, + $error + ); + } + + warn sprintf( + 'Autocorrected bad paydate stored in cust_main row '. + "custnum(%s) old-paydate(%s) new-paydate(%s)\n", + $row->custnum, + $bad_paydate, + $row->paydate, + ); + + } + + FS::upgrade_journal->set_done( $journal_label ); + dbh->commit unless $oldAutoCommit; +} + + sub queueable_upgrade { my $class = shift; @@ -5817,12 +5871,13 @@ sub _upgrade_next_recnum { my $recnum = shift @$recnums; return $recnum if $recnum; my $tclass = 'FS::'.$table; + my $paycardtypecheck = ($table ne 'cust_pay_pending') ? q( OR paycardtype = 'Tokenized') : ''; my $sql = 'SELECT '.$tclass->primary_key. ' FROM '.$table. ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum. " AND payby IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ". - " AND ( length(payinfo) > 80 OR paycardtype = 'Tokenized' ) ". - ' ORDER BY '.$tclass->primary_key.' LIMIT 500';; + " AND ( length(payinfo) < 80$paycardtypecheck ) ". + ' ORDER BY '.$tclass->primary_key.' LIMIT 500'; my $sth = $dbh->prepare($sql) or die $dbh->errstr; $sth->execute() or die $sth->errstr; my @recnums;