require 5.006;
use strict;
use Carp;
+use Try::Tiny;
use Scalar::Util qw( blessed );
-use Time::Local qw(timelocal);
-use Data::Dumper;
+use List::Util qw(min);
use Tie::IxHash;
+use File::Temp; #qw( tempfile );
+use Data::Dumper;
+use Time::Local qw(timelocal);
use Date::Format;
#use Date::Manip;
-use File::Temp; #qw( tempfile );
+use Email::Address;
use Business::CreditCard 0.28;
-use List::Util qw(min);
-use Try::Tiny;
use FS::UID qw( dbh driver_name );
use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
use FS::Cursor;
use FS::cust_payby;
use FS::contact;
use FS::reason;
+use FS::Misc::Savepoint;
+use FS::DBI;
# 1 is mostly method/subroutine entry and options
# 2 traces progress of some operations
=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
join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
if $DEBUG;
+ return "You are not permitted to change customer invoicing terms."
+ if $self->invoice_terms #i.e. not the default
+ && ! $FS::CurrentUser::CurrentUser->access_right('Edit customer invoice terms');
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
}
}
- # FS::geocode_Mixin::after_insert or something?
- if ( $conf->config('tax_district_method') and !$import ) {
- # if anything non-empty, try to look it up
- my $queue = new FS::queue {
- 'job' => 'FS::geocode_Mixin::process_district_update',
- 'custnum' => $self->custnum,
- };
- my $error = $queue->insert( ref($self), $self->custnum );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "queueing tax district update: $error";
- }
- }
-
# cust_main exports!
warn " exporting\n" if $DEBUG > 1;
$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";
}
the customer.
Currently available options are: I<tax_exemption>, I<cust_payby_params>,
-I<contact_params>, I<invoicing_list>.
+I<contact_params>, I<invoicing_list>, and I<move_pkgs>.
The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
of tax names and exemption numbers. FS::cust_main_exemption records will be
I<invoicing_list> is a synonym for the INVOICING_LIST_ARYREF parameter, and
should be used instead if possible.
+If I<move_pkgs> is an arrayref, it will override the list of packages
+to be moved to the new address (see L<FS::cust_location/move_pkgs>.)
+
=cut
sub replace {
&& ! $self->locale
&& $conf->exists('cust_main-require_locale');
+ return "You are not permitted to change customer invoicing terms."
+ if $old->invoice_terms ne $self->invoice_terms
+ && ! $curuser->access_right('Edit customer invoice terms');
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
$implicit_contact->set('emailaddress', $email);
$implicit_contact->set('invoice_dest', 'Y');
$implicit_contact->set('custnum', $self->custnum);
+ my $i_cust_contact =
+ qsearchs('cust_contact', {
+ contactnum => $implicit_contact->contactnum,
+ custnum => $self->custnum,
+ }
+ );
+ if ( $i_cust_contact ) {
+ $implicit_contact->set($_, $i_cust_contact->$_)
+ foreach qw( classnum selfservice_access comment );
+ }
my $error;
if ( $implicit_contact->contactnum ) {
$self->set('ship_location', ''); #flush cache
if ( $old->ship_locationnum and # should only be null during upgrade...
$old->ship_locationnum != $self->ship_locationnum ) {
- $error = $old->ship_location->move_to($self->ship_location);
+ $error = $old->ship_location->move_to($self->ship_location, move_pkgs => $options{'move_pkgs'});
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
my $payinfo = $self->payinfo;
$payinfo =~ s/\D//g;
- return '' if $payinfo =~ /^99\d{14}$/; #token
+ return '' if $self->tokenized($payinfo); #token
my %bop_card_types = map { $_=>1 } values %{ card_types() };
my $cardtype = cardtype($payinfo);
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>)
my( $self, %opt ) = @_;
# we're going to cancel services, which is not reversible
+ # unless exports are suppressed
die "cancel_pkgs cannot be run inside a transaction"
- if $FS::UID::AutoCommit == 0;
+ if !$FS::UID::AutoCommit && !$FS::svc_Common::noexport_hack;
+ my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
+ savepoint_create('cancel_pkgs');
+
return ( 'access denied' )
unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
my $error = $ban->insert;
if ($error) {
- dbh->rollback;
+ savepoint_rollback_and_release('cancel_pkgs');
+ dbh->rollback if $oldAutoCommit;
return ( $error );
}
'time' => $cancel_time );
if ($error) {
warn "Error billing during cancel, custnum ". $self->custnum. ": $error";
- dbh->rollback;
+ savepoint_rollback_and_release('cancel_pkgs');
+ dbh->rollback if $oldAutoCommit;
return ( "Error billing during cancellation: $error" );
}
}
- dbh->commit;
+ savepoint_release('cancel_pkgs');
+ dbh->commit if $oldAutoCommit;
my @errors;
# try to cancel each service, the same way we would for individual packages,
warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ".
$self->custnum."\n"
if $DEBUG;
+ my $i = 0;
foreach my $cust_svc (@sorted_cust_svc) {
+ my $savepoint = 'cancel_pkgs_'.$i++;
+ savepoint_create( $savepoint );
my $part_svc = $cust_svc->part_svc;
next if ( defined($part_svc) and $part_svc->preserve );
# immediate cancel, no date option
# transactionize individually
my $error = try { $cust_svc->cancel } catch { $_ };
if ( $error ) {
- dbh->rollback;
+ savepoint_rollback_and_release( $savepoint );
+ dbh->rollback if $oldAutoCommit;
push @errors, $error;
} else {
- dbh->commit;
+ savepoint_release( $savepoint );
+ dbh->commit if $oldAutoCommit;
}
}
if (@errors) {
@cprs = @{ delete $opt{'cust_pkg_reason'} };
}
my $null_reason;
+ $i = 0;
foreach (@pkgs) {
my %lopt = %opt;
+ my $savepoint = 'cancel_pkgs_'.$i++;
+ savepoint_create( $savepoint );
if (@cprs) {
my $cpr = shift @cprs;
if ( $cpr ) {
}
my $error = $_->cancel(%lopt);
if ( $error ) {
- dbh->rollback;
+ savepoint_rollback_and_release( $savepoint );
+ dbh->rollback if $oldAutoCommit;
push @errors, 'pkgnum '.$_->pkgnum.': '.$error;
} else {
- dbh->commit;
+ savepoint_release( $savepoint );
+ dbh->commit if $oldAutoCommit;
}
}
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
join(', ', $self->invoicing_list_emailonly);
}
-=item contact_list [ CLASSNUM, ... ]
+=item contact_list [ CLASSNUM, DEST_FLAG... ]
-Returns a list of contacts (L<FS::contact> objects) for the customer. If
-a list of contact classnums is given, returns only contacts in those
-classes. If the pseudo-classnum 'invoice' is given, returns contacts that
-are marked as invoice destinations. If '0' is given, also returns contacts
-with no class.
+Returns a list of contacts (L<FS::contact> objects) for the customer.
If no arguments are given, returns all contacts for the customer.
+Arguments may contain classnums. When classnums are specified, only
+contacts with a matching cust_contact.classnum are returned. When a
+classnum of 0 is given, contacts with a null classnum are also included.
+
+Arguments may also contain the dest flag names 'invoice' or 'message'.
+If given, contacts who's invoice_dest and/or message_dest flags are
+not set to 'Y' will be excluded.
+
=cut
sub contact_list {
my $self = shift;
my $search = {
table => 'contact',
- select => 'contact.*, cust_contact.invoice_dest',
+ select => join(', ',(
+ 'contact.*',
+ 'cust_contact.invoice_dest',
+ 'cust_contact.message_dest',
+ )),
addl_from => ' JOIN cust_contact USING (contactnum)',
extra_sql => ' WHERE cust_contact.custnum = '.$self->custnum,
};
- my @orwhere;
+ # Bugfix notes:
+ # Calling methods were relying on this method to use invoice_dest to
+ # block e-mail messages. Depending on parameters, this may or may not
+ # have actually happened.
+ #
+ # The bug could cause this SQL to be used to filter e-mail addresses:
+ #
+ # AND (
+ # cust_contact.classnums IN (1,2,3)
+ # OR cust_contact.invoice_dest = 'Y'
+ # )
+ #
+ # improperly including everybody with the opt-in flag AND everybody
+ # in the contact classes
+ #
+ # Possibility to introduce new bugs:
+ # If callers of this method called it incorrectly, and didn't notice
+ # because it seemed to send the e-mails they wanted.
+
+ # WHERE ...
+ # AND (
+ # (
+ # cust_contact.classnum IN (1,2,3)
+ # OR
+ # cust_contact.classnum IS NULL
+ # )
+ # AND (
+ # cust_contact.invoice_dest = 'Y'
+ # OR
+ # cust_contact.message_dest = 'Y'
+ # )
+ # )
+
+ my @and_dest;
+ my @or_classnum;
my @classnums;
- foreach (@_) {
- if ( $_ eq 'invoice' ) {
- push @orwhere, 'cust_contact.invoice_dest = \'Y\'';
- } elsif ( $_ eq '0' ) {
- push @orwhere, 'cust_contact.classnum is null';
+ for (@_) {
+ if ($_ eq 'invoice' || $_ eq 'message') {
+ push @and_dest, " cust_contact.${_}_dest = 'Y' ";
+ } elsif ($_ eq '0') {
+ push @or_classnum, ' cust_contact.classnum IS NULL ';
} elsif ( /^\d+$/ ) {
push @classnums, $_;
} else {
- die "bad classnum argument '$_'";
+ croak "bad classnum argument '$_'";
}
}
- if (@classnums) {
- push @orwhere, 'cust_contact.classnum IN ('.join(',', @classnums).')';
- }
- if (@orwhere) {
- $search->{extra_sql} .= ' AND (' .
- join(' OR ', map "( $_ )", @orwhere) .
- ')';
+ push @or_classnum, 'cust_contact.classnum IN ('.join(',',@classnums).')'
+ if @classnums;
+
+ if (@or_classnum || @and_dest) { # catch, no arguments given
+ $search->{extra_sql} .= ' AND ( ';
+
+ if (@or_classnum) {
+ $search->{extra_sql} .= ' ( ';
+ $search->{extra_sql} .= join ' OR ', map {" $_ "} @or_classnum;
+ $search->{extra_sql} .= ' ) ';
+ $search->{extra_sql} .= ' AND ( ' if @and_dest;
+ }
+
+ if (@and_dest) {
+ $search->{extra_sql} .= join ' OR ', map {" $_ "} @and_dest;
+ $search->{extra_sql} .= ' ) ' if @or_classnum;
+ }
+
+ $search->{extra_sql} .= ' ) ';
+
+ warn "\$extra_sql: $search->{extra_sql} \n" if $DEBUG;
}
qsearch($search);
my @emails;
foreach my $contact (@contacts) {
foreach my $contact_email ($contact->contact_email) {
- push @emails,
- $contact->firstlast . ' <' . $contact_email->emailaddress . '>';
+ push @emails, Email::Address->new( $contact->firstlast,
+ $contact_email->emailaddress
+ )->format;
}
}
@emails;
}
+=item contact_list_email_destinations
+
+Returns a list of emails and whether they receive invoices or messages destinations.
+{ emailaddress => 'email.com', invoice => 'Y', message => '', }
+
+=cut
+
+sub contact_list_email_destinations {
+ my $self = shift;
+ warn "$me contact_list_email_destinations"
+ if $DEBUG;
+ return () if !$self->custnum; # not yet inserted
+ return map { $_ }
+ qsearch({
+ table => 'cust_contact',
+ select => 'emailaddress, cust_contact.invoice_dest as invoice, cust_contact.message_dest as message',
+ addl_from => ' JOIN contact USING (contactnum) '.
+ ' JOIN contact_email USING (contactnum)',
+ hashref => { 'custnum' => $self->custnum, },
+ order_by => 'ORDER BY custcontactnum DESC',
+ extra_sql => '',
+ });
+}
+
+=item contact_list_name_phones
+
+Returns a list of contact phone numbers.
+{ phonetypenum => '1', phonenum => 'xxxxxxxxxx', first => 'firstname', last => 'lastname', countrycode => '1' }
+
+=cut
+
+sub contact_list_name_phones {
+ my $self = shift;
+ my $phone_type = shift;
+
+ warn "$me contact_list_phones" if $DEBUG;
+
+ return () if !$self->custnum; # not yet inserted
+ return map { $_ }
+ qsearch({
+ table => 'cust_contact',
+ select => 'phonetypenum, phonenum, first, last, countrycode',
+ addl_from => ' JOIN contact USING (contactnum) '.
+ ' JOIN contact_phone USING (contactnum)',
+ hashref => { 'custnum' => $self->custnum, 'phonetypenum' => $phone_type, },
+ order_by => 'ORDER BY custcontactnum DESC',
+ extra_sql => '',
+ });
+}
+
+=item contact_list_emailonly
+
+Returns an array of hashes containing the emails. Used for displaying contact email field in advanced customer reports.
+[ { data => 'email.com', }, ]
+
+=cut
+
+sub contact_list_emailonly {
+ my $self = shift;
+ warn "$me contact_list_emailonly called"
+ if $DEBUG;
+ my @emails;
+ foreach ($self->contact_list_email_destinations) {
+ my $data = [
+ {
+ 'data' => $_->emailaddress,
+ },
+ ];
+ push @emails, $data;
+ }
+ return \@emails;
+}
+
+=item contact_list_cust_invoice_only
+
+Returns an array of hashes containing cust_contact.invoice_dest. Does this email receive invoices. Used for displaying email Invoice field in advanced customer reports.
+[ { data => 'Yes', }, ]
+
+=cut
+
+sub contact_list_cust_invoice_only {
+ my $self = shift;
+ warn "$me contact_list_cust_invoice_only called"
+ if $DEBUG;
+ my @emails;
+ foreach ($self->contact_list_email_destinations) {
+ my $invoice = $_->invoice ? 'Yes' : 'No';
+ my $data = [
+ {
+ 'data' => $invoice,
+ },
+ ];
+ push @emails, $data;
+ }
+ return \@emails;
+}
+
+=item contact_list_cust_message_only
+
+Returns an array of hashes containing cust_contact.message_dest. Does this email receive message notifications. Used for displaying email Message field in advanced customer reports.
+[ { data => 'Yes', }, ]
+
+=cut
+
+sub contact_list_cust_message_only {
+ my $self = shift;
+ warn "$me contact_list_cust_message_only called"
+ if $DEBUG;
+ my @emails;
+ foreach ($self->contact_list_email_destinations) {
+ my $message = $_->message ? 'Yes' : 'No';
+ my $data = [
+ {
+ 'data' => $message,
+ },
+ ];
+ push @emails, $data;
+ }
+ return \@emails;
+}
+
=item referral_custnum_cust_main
Returns the customer who referred this customer (or the empty string, if
my $cust_pkg_ref = '';
my ( $bill_now, $invoice_terms ) = ( 0, '' );
my $locationnum;
+ my ( $discountnum, $discountnum_amount, $discountnum_percent ) = ( '','','' );
if ( ref( $_[0] ) ) {
$amount = $_[0]->{amount};
$setup_cost = $_[0]->{setup_cost};
$invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
$locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
$separate_bill = $_[0]->{separate_bill} || '';
+ $discountnum = $_[0]->{setup_discountnum};
+ $discountnum_amount = $_[0]->{setup_discountnum_amount};
+ $discountnum_percent = $_[0]->{setup_discountnum_percent};
} else { # yuck
$amount = shift;
$setup_cost = '';
}
my $cust_pkg = new FS::cust_pkg ( {
- 'custnum' => $self->custnum,
- 'pkgpart' => $pkgpart,
- 'quantity' => $quantity,
- 'start_date' => $start_date,
- 'no_auto' => $no_auto,
- 'separate_bill' => $separate_bill,
- 'locationnum'=> $locationnum,
+ 'custnum' => $self->custnum,
+ 'pkgpart' => $pkgpart,
+ 'quantity' => $quantity,
+ 'start_date' => $start_date,
+ 'no_auto' => $no_auto,
+ 'separate_bill' => $separate_bill,
+ 'locationnum' => $locationnum,
+ 'setup_discountnum' => $discountnum,
+ 'setup_discountnum_amount' => $discountnum_amount,
+ 'setup_discountnum_percent' => $discountnum_percent,
} );
$error = $cust_pkg->insert;
$error ? $error : $cust_pkg;
}
+=item num_cust_attachment_deleted
+
+Returns the number of deleted attachments for this customer (see
+L<FS::num_cust_attachment>).
+
+=cut
+
+sub num_cust_attachments_deleted {
+ my $self = shift;
+ $self->scalar_sql(
+ " SELECT COUNT(*) FROM cust_attachment ".
+ " WHERE custnum = ? AND disabled IS NOT NULL AND disabled > 0",
+ $self->custnum
+ );
+}
+
+=item max_invnum
+
+Returns the most recent invnum (invoice number) for this customer.
+
+=cut
+
+sub max_invnum {
+ my $self = shift;
+ $self->scalar_sql(
+ " SELECT MAX(invnum) FROM cust_bill WHERE custnum = ?",
+ $self->custnum
+ );
+}
+
=item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
Returns all the invoices (see L<FS::cust_bill>) for this customer.
$name;
}
+=item batch_payment_payname
+
+Returns a name string for this customer, either "cust_batch_payment->payname" or "First Last" or "Company,
+based on if a company name exists and is the account being used a business account.
+
+=cut
+
+sub batch_payment_payname {
+ my $self = shift;
+ my $cust_pay_batch = shift;
+ my $name;
+
+ if ($cust_pay_batch->{Hash}->{payby} eq "CARD") { $name = $cust_pay_batch->payname; }
+ else { $name = $self->first .' '. $self->last; }
+
+ $name = $self->company
+ if (($cust_pay_batch->{Hash}->{paytype} eq "Business checking" || $cust_pay_batch->{Hash}->{paytype} eq "Business savings") && $self->company);
+
+ $name;
+}
+
=item service_contact
Returns the L<FS::contact> object for this customer that has the 'Service'
next if grep(/^$field$/, qw( custpaybynum payby weight ) );
next if grep(/^$field$/, @preserve );
next PAYBYLOOP unless $new->get($field) eq $cust_payby->get($field);
+ # check if paymask exists, if so stop and don't save, no need for a duplicate.
+ return '' if $new->get('paymask') eq $cust_payby->get('paymask');
}
# now check fields that can replace if one value is blank
my $replace = 0;
$param->{'fatal'} = 1; # runs from job queue, will be caught
$param->{'retry'} = 1;
- $cust_main->bill_and_collect( %$param );
+ local $@;
+ eval { $cust_main->bill_and_collect( %$param) };
+ if ( $@ ) {
+ die $@ =~ /cancel_pkgs cannot be run inside a transaction/
+ ? "Bill Now unavailable for customer with pending package expiration\n"
+ : $@;
+ }
+}
+
+=item pending_invoice_count
+
+Return number of cust_bill with pending=Y for this customer
+
+=cut
+
+sub pending_invoice_count {
+ FS::cust_bill->count( 'custnum = '.shift->custnum."AND pending = 'Y'" );
+}
+
+=item cust_locations_missing_district
+
+Always returns empty list, unless tax_district_method eq 'wa_sales'
+
+Return cust_location rows for this customer, associated with active
+customer packages, where tax district column is empty. Presense of
+these rows should block billing, because invoice would be generated
+with incorrect taxes
+
+=cut
+
+sub cust_locations_missing_district {
+ my ( $self ) = @_;
+
+ my $tax_district_method = FS::Conf->new->config('tax_district_method');
+
+ return ()
+ unless $tax_district_method
+ && $tax_district_method eq 'wa_sales';
+
+ qsearch({
+ table => 'cust_location',
+ select => 'cust_location.*',
+ addl_from => '
+ LEFT JOIN cust_main USING (custnum)
+ LEFT JOIN cust_pkg ON cust_location.locationnum = cust_pkg.locationnum
+ ',
+ extra_sql => sprintf(q{
+ WHERE cust_location.state = 'WA'
+ AND cust_location.custnum = %s
+ AND (
+ cust_location.district IS NULL
+ or cust_location.district = ''
+ )
+ AND cust_pkg.pkgnum IS NOT NULL
+ AND (
+ cust_pkg.cancel > %s
+ OR cust_pkg.cancel IS NULL
+ )
+ },
+ $self->custnum, time()
+ ),
+ });
}
#starting to take quite a while for big dbs
$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();
+ }
+
+}
+
+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 (qw(
+ cust_payby 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 (qw(
+ cust_payby 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');
+ }
+
+ # now that everything's encrypted, tokenize...
+ FS::cust_main::Billing_Realtime::token_check(@_);
+}
+
+# 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
=cut
1;
-