use Date::Format;
#use Date::Manip;
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 );
IP address from which payment information was received
+=item paycardtype
+
+The credit card type (deduced from the card number).
+
=item tax
Tax exempt, empty or `Y'
|| $self->ut_floatn('credit_limit')
|| $self->ut_numbern('billday')
|| $self->ut_numbern('prorate_day')
+ || $self->ut_flag('force_prorate_day')
|| $self->ut_flag('edit_subject')
|| $self->ut_flag('calling_list_exempt')
|| $self->ut_flag('invoice_noemail')
validate($payinfo)
or return gettext('invalid_card'); # . ": ". $self->payinfo;
- return gettext('unknown_card_type')
- if $self->payinfo !~ /^99\d{14}$/ #token
- && cardtype($self->payinfo) eq "Unknown";
+ 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';
+
+ $self->set('paycardtype', $cardtype);
unless ( $ignore_banned_card ) {
my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
}
if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
- if ( cardtype($self->payinfo) eq 'American Express card' ) {
+ if ( $cardtype eq 'American Express card' ) {
$self->paycvv =~ /^(\d{4})$/
or return "CVV2 (CID) for American Express cards is four digits.";
$self->paycvv($1);
$self->paycvv('');
}
- my $cardtype = cardtype($payinfo);
if ( $cardtype =~ /^(Switch|Solo)$/i ) {
return "Start date or issue number is required for $cardtype cards"
unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
$self->paycvv('');
+ } elsif ( $self->payby =~ /^CARD|DCRD$/ and $self->paymask ) {
+ # either ignoring invalid cards, or we can't decrypt the payinfo, but
+ # try to detect the card type anyway. this never returns failure, so
+ # the contract of $ignore_invalid_cards is maintained.
+ $self->set('paycardtype', cardtype($self->paymask));
}
if ( $self->paydate eq '' || $self->paydate eq '-' ) {
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)$/ &&
&& ! $self->custnum
&& $conf->exists('cust_main-require_locale');
+ return "Please select a customer class"
+ if ! $self->classnum
+ && $conf->exists('cust_main-require_classnum');
+
foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
$self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
$self->$flag($1);
my $payinfo = $self->payinfo;
$payinfo =~ s/\D//g;
- return '' if $payinfo =~ /^99\d{14}$/; #token
+ if ( $payinfo =~ /^99\d{14}$/ ) {
+ return '';
+ }
my %bop_card_types = map { $_=>1 } values %{ card_types() };
my $cardtype = cardtype($payinfo);
+ $self->set('paycardtype', $cardtype);
return "$cardtype not accepted" unless $bop_card_types{$cardtype};
sub unsuspend {
my $self = shift;
- grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
+ grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs(@_);
}
=item release_hold
}
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;
# unlike on 4.x, we have a separate list of invoice email
# destinations.
# make sure they're not redundant with contact emails
- my $dest = $contact->firstlast . ' <' . $contact_email->emailaddress . '>';
- $emails{ $contact_email->emailaddress } = $dest;
+ $emails{ $contact_email->emailaddress } =
+ Email::Address->new( $contact->firstlast,
+ $contact_email->emailaddress
+ )->format;
}
}
}
if ( $and_invoice ) {
foreach my $email ($self->invoicing_list_emailonly) {
- my $dest = $self->name_short . ' <' . $email . '>';
- $emails{ $email } ||= $dest;
+ $emails{ $email } ||=
+ Email::Address->new( $self->name_short, $email )->format;
}
}
values %emails;
=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
$class->_upgrade_otaker(%opts);
+ # turn on encryption as part of regular upgrade, so all new records are immediately encrypted
+ # existing records will be encrypted in queueable_upgrade (below)
+ unless ($conf->exists('encryptionpublickey') || $conf->exists('encryptionprivatekey')) {
+ eval "use FS::Setup";
+ die $@ if $@;
+ 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;
+
+ ### encryption gets turned on in _upgrade_data, above
+
+ eval "use FS::upgrade_journal";
+ die $@ if $@;
+
+ # prior to 2013 (commit f16665c9) payinfo was stored in history if not encrypted,
+ # clear that out before encrypting/tokenizing anything else
+ if (!FS::upgrade_journal->is_done('clear_payinfo_history')) {
+ foreach my $table ('cust_main','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
+ my $sql = 'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL';
+ my $sth = dbh->prepare($sql) or die dbh->errstr;
+ $sth->execute or die $sth->errstr;
+ }
+ FS::upgrade_journal->set_done('clear_payinfo_history');
+ }
+
+ # fix Tokenized paycardtype and encrypt old records
+ if ( ! FS::upgrade_journal->is_done('paycardtype_Tokenized')
+ || ! FS::upgrade_journal->is_done('encryption_check')
+ )
+ {
+
+ # allow replacement of closed cust_pay/cust_refund records
+ local $FS::payinfo_Mixin::allow_closed_replace = 1;
+
+ # because it looks like nothing's changing
+ local $FS::Record::no_update_diff = 1;
+
+ # commit everything immediately
+ local $FS::UID::AutoCommit = 1;
+
+ # encrypt what's there
+ foreach my $table ('cust_main','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
+ my $tclass = 'FS::'.$table;
+ my $lastrecnum = 0;
+ my @recnums = ();
+ while (my $recnum = _upgrade_next_recnum(dbh,$table,\$lastrecnum,\@recnums)) {
+ my $record = $tclass->by_key($recnum);
+ next unless $record; # small chance it's been deleted, that's ok
+ next unless grep { $record->payby eq $_ } @FS::Record::encrypt_payby;
+ # window for possible conflict is practically nonexistant,
+ # but just in case...
+ $record = $record->select_for_update;
+ if (!$record->custnum && $table eq 'cust_pay_pending') {
+ $record->set('custnum_pending',1);
+ }
+ $record->paycardtype('') if $record->paycardtype eq 'Tokenized';
+
+ local($ignore_expired_card) = 1;
+ local($ignore_banned_card) = 1;
+ local($skip_fuzzyfiles) = 1;
+ local($import) = 1;#prevent automatic geocoding (need its own variable?)
+
+ my $error = $record->replace;
+ die "Error replacing $table ".$record->get($record->primary_key).": $error" if $error;
+ }
+ }
+
+ FS::upgrade_journal->set_done('paycardtype_Tokenized');
+ FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption');
+ }
+
+}
+
+# not entirely false laziness w/ Billing_Realtime::_token_check_next_recnum
+# cust_payby might get deleted while this runs
+# not a method!
+sub _upgrade_next_recnum {
+ my ($dbh,$table,$lastrecnum,$recnums) = @_;
+ 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$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;
+ while (my $rec = $sth->fetchrow_hashref) {
+ push @$recnums, $rec->{$tclass->primary_key};
+ }
+ $sth->finish();
+ $$lastrecnum = $$recnums[-1];
+ return shift @$recnums;
}
=back