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 );
=item dundate
-A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
+A suggestion to events (see L<FS::part_bill_event>) to delay until this unix timestamp
=item squelch_cdr
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';
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)$/ &&
sub unsuspend {
my $self = shift;
- grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
+ grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs(@_);
}
=item release_hold
=item quiet - can be set true to supress email cancellation notices.
-=item reason - can be set to a cancellation reason (see L<FS:reason>), either a
+=item reason - can be set to a cancellation reason (see L<FS::reason>), 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<FS::reason_type>)
}
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] }
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;
}
}
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;
} );
foreach (qw( address1 address2 city state zip country latitude longitude
- payby payinfo paydate payname ))
+ payby payinfo paydate payname paycode paytype ))
{
$options{$_} = '' unless exists($options{$_});
}
'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)
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;
L<Date::Parse> for conversion functions. The empty string can be passed
to disable that time constraint completely.
-Accepts the same options as L<balance_date_sql>:
+Accepts the same options as L</balance_date_sql>:
=over 4
=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
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;
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;
projects / freeside.git / blobdiff