X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=90256bd8197a2e602355fb51bdf5fceb7fb0025b;hp=206f1b0bf82c979c60018b6b7ee9ab3a2285fe11;hb=faa774764df03c6f3280177f6adfcd2214995a13;hpb=b664241d5e97c8bd2c2d44a961d08aa8c1f0feb5 diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 206f1b0bf..90256bd81 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -20,13 +20,16 @@ use base qw( FS::cust_main::Packages 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 FS::UID qw( dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); @@ -75,6 +78,7 @@ use FS::upgrade_journal; use FS::sales; use FS::cust_payby; use FS::contact; +use FS::reason; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -97,12 +101,15 @@ our @encrypted_fields = ('payinfo', 'paycvv'); sub nohistory_fields { ('payinfo', 'paycvv'); } our $conf; +our $default_agent_custid; +our $custnum_display_length; #ask FS::UID to run this stuff for us later #$FS::UID::callback{'FS::cust_main'} = sub { install_callback FS::UID sub { $conf = new FS::Conf; - #yes, need it for stuff below (prolly should be cached) - $ignore_invalid_card = $conf->exists('allow_invalid_cards'); + $ignore_invalid_card = $conf->exists('allow_invalid_cards'); + $default_agent_custid = $conf->exists('cust_main-default_agent_custid'); + $custnum_display_length = $conf->config('cust_main-custnum-display_length'); }; sub _cache { @@ -528,6 +535,7 @@ sub insert { foreach my $prospect_contact ( $prospect_main->prospect_contact ) { my $cust_contact = new FS::cust_contact { 'custnum' => $self->custnum, + 'invoice_dest' => 'Y', # invoice_dest currently not set for prospect contacts map { $_ => $prospect_contact->$_() } qw( contactnum classnum comment ) }; my $error = $cust_contact->insert @@ -550,7 +558,10 @@ sub insert { return $error; } } - + # since we set invoice_dest on all migrated prospect contacts (for now), + # don't process invoicing_list. + delete $options{'invoicing_list'}; + $invoicing_list = undef; } warn " setting contacts\n" @@ -574,8 +585,7 @@ sub insert { custnum => $self->custnum, }); $cust_contact->set('invoice_dest', 'Y'); - my $error = $cust_contact->contactnum ? - $cust_contact->replace : $cust_contact->insert; + my $error = $cust_contact->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "$error (linking to email address $dest)"; @@ -589,17 +599,21 @@ sub insert { } } - my $contact = FS::contact->new({ - 'custnum' => $self->get('custnum'), - 'last' => $self->get('last'), - 'first' => $self->get('first'), - 'emailaddress' => $email, - 'invoice_dest' => 'Y', # yes, you can set this via the contact - }); - my $error = $contact->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + if ( $email ) { + + my $contact = FS::contact->new({ + 'custnum' => $self->get('custnum'), + 'last' => $self->get('last'), + 'first' => $self->get('first'), + 'emailaddress' => $email, + 'invoice_dest' => 'Y', # yes, you can set this via the contact + }); + my $error = $contact->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } } @@ -1762,13 +1776,14 @@ sub check { || $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') || $self->ut_flag('message_noemail') || $self->ut_enum('locale', [ '', FS::Locales->locales ]) || $self->ut_currencyn('currency') - || $self->ut_alphan('po_number') + || $self->ut_textn('po_number') || $self->ut_enum('complimentary', [ '', 'Y' ]) || $self->ut_flag('invoice_ship_address') || $self->ut_flag('invoice_dest') @@ -1856,6 +1871,10 @@ sub check { && ! $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); @@ -1877,7 +1896,7 @@ sub check_payinfo_cardtype { 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); @@ -1950,8 +1969,13 @@ Returns all locations (see L) for this customer. sub cust_location { my $self = shift; - qsearch('cust_location', { 'custnum' => $self->custnum, - 'prospectnum' => '' } ); + qsearch({ + 'table' => 'cust_location', + 'hashref' => { 'custnum' => $self->custnum, + 'prospectnum' => '', + }, + 'order_by' => 'ORDER BY country, LOWER(state), LOWER(city), LOWER(county), LOWER(address1), LOWER(address2)', + }); } =item cust_contact @@ -1982,7 +2006,9 @@ sub cust_payby { 'hashref' => { 'custnum' => $self->custnum }, 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC", }; - $search->{'extra_sql'} = ' AND payby IN ( ' . join(',', map { dbh->quote($_) } @payby) . ' ) ' + $search->{'extra_sql'} = ' AND payby IN ( '. + join(',', map dbh->quote($_), @payby). + ' ) ' if @payby; qsearch($search); @@ -2112,33 +2138,63 @@ sub suspend_unless_pkgpart { =item cancel [ OPTION => VALUE ... ] Cancels all uncancelled packages (see L) for this customer. +The cancellation time will be now. -Available options are: +=back + +Always returns a list: an empty list on success or a list of errors. + +=cut + +sub cancel { + my $self = shift; + my %opt = @_; + warn "$me cancel called on customer ". $self->custnum. " with options ". + join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n" + if $DEBUG; + my @pkgs = $self->ncancelled_pkgs; + + $self->cancel_pkgs( %opt, 'cust_pkg' => \@pkgs ); +} + +=item cancel_pkgs OPTIONS + +Cancels a specified list of packages. OPTIONS can include: =over 4 +=item cust_pkg - an arrayref of the packages. Required. + +=item time - the cancellation time, used to calculate final bills and +unused-time credits if any. Will be passed through to the bill() and +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 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, reason - Text of the new reason. +=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) +reason - Text of the new reason. + +=item cust_pkg_reason - can be an arrayref of L objects +for the individual packages, parallel to the C argument. The +reason and reason_otaker arguments will be taken from those objects. =item ban - can be set true to ban this customer's credit card or ACH information, if present. =item nobill - can be set true to skip billing if it might otherwise be done. -=back - -Always returns a list: an empty list on success or a list of errors. - =cut -# nb that dates are not specified as valid options to this method - -sub cancel { +sub cancel_pkgs { my( $self, %opt ) = @_; - warn "$me cancel called on customer ". $self->custnum. " with options ". - join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n" - if $DEBUG; + # we're going to cancel services, which is not reversible + die "cancel_pkgs cannot be run inside a transaction" + if $FS::UID::AutoCommit == 0; + + local $FS::UID::AutoCommit = 0; return ( 'access denied' ) unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer'); @@ -2155,26 +2211,101 @@ sub cancel { my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref; my $error = $ban->insert; - return ( $error ) if $error; + if ($error) { + dbh->rollback; + return ( $error ); + } } } - my @pkgs = $self->ncancelled_pkgs; + my @pkgs = @{ delete $opt{'cust_pkg'} }; + my $cancel_time = $opt{'time'} || time; + # bill all packages first, so we don't lose usage, service counts for + # bulk billing, etc. if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) { $opt{nobill} = 1; - my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 ); - warn "Error billing during cancel, custnum ". $self->custnum. ": $error" - if $error; + my $error = $self->bill( 'pkg_list' => [ @pkgs ], + 'cancel' => 1, + 'time' => $cancel_time ); + if ($error) { + warn "Error billing during cancel, custnum ". $self->custnum. ": $error"; + dbh->rollback; + return ( "Error billing during cancellation: $error" ); + } + } + dbh->commit; + + my @errors; + # 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] } + sort { $a->[1] <=> $b->[1] } + map { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; } @cust_svc + ; + warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ". + $self->custnum."\n" + if $DEBUG; + foreach my $cust_svc (@sorted_cust_svc) { + 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; + push @errors, $error; + } else { + dbh->commit; + } + } + if (@errors) { + return @errors; } - warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/". - scalar(@pkgs). " packages for customer ". $self->custnum. "\n" + warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ". + $self->custnum. "\n" if $DEBUG; - grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs; + my @cprs; + if ($opt{'cust_pkg_reason'}) { + @cprs = @{ delete $opt{'cust_pkg_reason'} }; + } + my $null_reason; + foreach (@pkgs) { + my %lopt = %opt; + if (@cprs) { + my $cpr = shift @cprs; + if ( $cpr ) { + $lopt{'reason'} = $cpr->reasonnum; + $lopt{'reason_otaker'} = $cpr->otaker; + } else { + warn "no reason found when canceling package ".$_->pkgnum."\n"; + # we're not actually required to pass a reason to cust_pkg::cancel, + # but if we're getting to this point, something has gone awry. + $null_reason ||= FS::reason->new_or_existing( + reason => 'unknown reason', + type => 'Cancel Reason', + class => 'C', + ); + $lopt{'reason'} = $null_reason->reasonnum; + $lopt{'reason_otaker'} = $FS::CurrentUser::CurrentUser->username; + } + } + my $error = $_->cancel(%lopt); + if ( $error ) { + dbh->rollback; + push @errors, 'pkgnum '.$_->pkgnum.': '.$error; + } else { + dbh->commit; + } + } + + return @errors; } sub _banned_pay_hashref { @@ -2327,6 +2458,8 @@ Removes the I field from the database directly. If there is an error, returns the error, otherwise returns false. +DEPRECATED. Use L instead. + =cut sub remove_cvv { @@ -2701,64 +2834,34 @@ sub payment_info { =item paydate_epoch -Returns the exact time in seconds corresponding to the payment method -expiration date. For CARD/DCRD customers this is the end of the month; -for others (COMP is the only other payby that uses paydate) it's the start. -Returns 0 if the paydate is empty or set to the far future. +Returns the next payment expiration date for this customer. If they have no +payment methods that will expire, returns 0. =cut -#XXX i need to be updated for 4.x+ sub paydate_epoch { my $self = shift; - my ($month, $year) = $self->paydate_monthyear; - return 0 if !$year or $year >= 2037; - if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) { - $month++; - if ( $month == 13 ) { - $month = 1; - $year++; - } - return timelocal(0,0,0,1,$month-1,$year) - 1; - } - else { - return timelocal(0,0,0,1,$month-1,$year); - } + # filter out the ones that individually return 0, but then return 0 if + # there are no results + my @epochs = grep { $_ > 0 } map { $_->paydate_epoch } $self->cust_payby; + min( @epochs ) || 0; } =item paydate_epoch_sql -Class method. Returns an SQL expression to obtain the payment expiration date -as a number of seconds. +Returns an SQL expression to get the next payment expiration date for a +customer. Returns 2143260000 (2037-12-01) if there are no payment expiration +dates, so that it's safe to test for "will it expire before date X" for any +date up to then. =cut -# XXX i need to be updated for 4.x+ -# Special expiration date behavior for non-CARD/DCRD customers has been -# carefully preserved. Do we really use that? sub paydate_epoch_sql { my $class = shift; - my $table = shift || 'cust_main'; - my ($case1, $case2); - if ( driver_name eq 'Pg' ) { - $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1"; - $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )"; - } - elsif ( lc(driver_name) eq 'mysql' ) { - $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1"; - $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )"; - } - else { return '' } - return "CASE WHEN $table.payby IN('CARD','DCRD') - THEN ($case1) - ELSE ($case2) - END" + my $paydate = FS::cust_payby->paydate_epoch_sql; + "(SELECT COALESCE(MIN($paydate), 2143260000) FROM cust_payby WHERE cust_payby.custnum = cust_main.custnum)"; } -=item tax_exemption TAXNAME - -=cut - sub tax_exemption { my( $self, $taxname ) = @_; @@ -2898,6 +3001,74 @@ sub invoicing_list_emailonly_scalar { join(', ', $self->invoicing_list_emailonly); } +=item contact_list [ CLASSNUM, ... ] + +Returns a list of contacts (L 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. + +If no arguments are given, returns all contacts for the customer. + +=cut + +sub contact_list { + my $self = shift; + my $search = { + table => 'contact', + select => 'contact.*, cust_contact.invoice_dest', + addl_from => ' JOIN cust_contact USING (contactnum)', + extra_sql => ' WHERE cust_contact.custnum = '.$self->custnum, + }; + + my @orwhere; + my @classnums; + foreach (@_) { + if ( $_ eq 'invoice' ) { + push @orwhere, 'cust_contact.invoice_dest = \'Y\''; + } elsif ( $_ eq '0' ) { + push @orwhere, 'cust_contact.classnum is null'; + } elsif ( /^\d+$/ ) { + push @classnums, $_; + } else { + die "bad classnum argument '$_'"; + } + } + + if (@classnums) { + push @orwhere, 'cust_contact.classnum IN ('.join(',', @classnums).')'; + } + if (@orwhere) { + $search->{extra_sql} .= ' AND (' . + join(' OR ', map "( $_ )", @orwhere) . + ')'; + } + + qsearch($search); +} + +=item contact_list_email [ CLASSNUM, ... ] + +Same as L, but returns email destinations instead of contact +objects. + +=cut + +sub contact_list_email { + my $self = shift; + my @contacts = $self->contact_list(@_); + my @emails; + foreach my $contact (@contacts) { + foreach my $contact_email ($contact->contact_email) { + push @emails, Email::Address->new( $contact->firstlast, + $contact_email->emailaddress + )->format; + } + } + @emails; +} + =item referral_custnum_cust_main Returns the customer who referred this customer (or the empty string, if @@ -3235,6 +3406,22 @@ sub charge_postal_fee { $error ? $error : $cust_pkg; } +=item num_cust_attachment_deleted + +Returns the number of deleted attachments for this customer (see +L). + +=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 cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all the invoices (see L) for this customer. @@ -3393,9 +3580,12 @@ Returns all the credits (see L) for this customer. sub cust_credit { my $self = shift; - map { $_ } #return $self->num_cust_credit unless wantarray; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) + + #return $self->num_cust_credit unless wantarray; + + map { $_ } #behavior of sort undefined in scalar context + sort { $a->_date <=> $b->_date } + qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) } =item cust_credit_pkgnum @@ -3605,34 +3795,16 @@ cust_main-default_agent_custid is set and it has a value, custnum otherwise. sub display_custnum { my $self = shift; + return $self->agent_custid + if $default_agent_custid && $self->agent_custid; + my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || ''; - if ( my $special = $conf->config('cust_main-custnum-display_special') ) { - if ( $special eq 'CoStAg' ) { - $prefix = uc( join('', - $self->country, - ($self->state =~ /^(..)/), - $prefix || ($self->agent->agent =~ /^(..)/) - ) ); - } - elsif ( $special eq 'CoStCl' ) { - $prefix = uc( join('', - $self->country, - ($self->state =~ /^(..)/), - ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__') - ) ); - } - # add any others here if needed - } - my $length = $conf->config('cust_main-custnum-display_length'); - if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){ - return $self->agent_custid; - } elsif ( $prefix ) { - $length = 8 if !defined($length); + if ( $prefix ) { return $prefix . - sprintf('%0'.$length.'d', $self->custnum) - } elsif ( $length ) { - return sprintf('%0'.$length.'d', $self->custnum); + sprintf('%0'.($custnum_display_length||8).'d', $self->custnum) + } elsif ( $custnum_display_length ) { + return sprintf('%0'.$custnum_display_length.'d', $self->custnum); } else { return $self->custnum; } @@ -3839,13 +4011,17 @@ sub status { shift->cust_status(@_); } sub cust_status { my $self = shift; + return $self->hashref->{cust_status} if $self->hashref->{cust_status}; for my $status ( FS::cust_main->statuses() ) { my $method = $status.'_sql'; my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g; my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr; $sth->execute( ($self->custnum) x $numnum ) or die "Error executing 'SELECT $sql': ". $sth->errstr; - return $status if $sth->fetchrow_arrayref->[0]; + if ( $sth->fetchrow_arrayref->[0] ) { + $self->hashref->{cust_status} = $status; + return $status; + } } } @@ -4286,6 +4462,10 @@ CHEK only CHEK only +=item saved_cust_payby + +scalar reference, for returning saved object + =back =cut @@ -4337,7 +4517,10 @@ sub save_cust_payby { # compare to FS::cust_main::realtime_bop - check both to make sure working correctly if ( $payby eq 'CARD' && - grep { $_ eq cardtype($opt{'payinfo'}) } $conf->config('cvv-save') ) { + ( (grep { $_ eq cardtype($opt{'payinfo'}) } $conf->config('cvv-save')) + || $conf->exists('business-onlinepayment-verification') + ) + ) { $new->set( 'paycvv' => $opt{'paycvv'} ); } else { $new->set( 'paycvv' => ''); @@ -4479,11 +4662,41 @@ PAYBYLOOP: return $error; } + ${$opt{'saved_cust_payby'}} = $new + if $opt{'saved_cust_payby'}; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } +=item remove_cvv_from_cust_payby PAYINFO + +Removes paycvv from associated cust_payby with matching PAYINFO. + +=cut + +sub remove_cvv_from_cust_payby { + my ($self,$payinfo) = @_; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $cust_payby ( qsearch('cust_payby',{ custnum => $self->custnum }) ) { + next unless $cust_payby->payinfo eq $payinfo; # can't qsearch on payinfo + $cust_payby->paycvv(''); + my $error = $cust_payby->replace; + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + =back =head1 CLASS METHODS @@ -4621,15 +4834,10 @@ Returns an SQL expression identifying un-cancelled cust_main records. =cut sub uncancelled_sql { uncancel_sql(@_); } -sub uncancel_sql { " - ( 0 < ( $select_count_pkgs - AND ( cust_pkg.cancel IS NULL - OR cust_pkg.cancel = 0 - ) - ) - OR 0 = ( $select_count_pkgs ) - ) -"; } +sub uncancel_sql { + my $self = shift; + "( NOT (".$self->cancelled_sql.") )"; #sensitive to cust_main-status_module +} =item balance_sql @@ -5146,6 +5354,110 @@ sub _upgrade_data { #class method $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'); + } + + # encrypt old records + if ( $conf->exists('encryption') + && ! 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); + } + + 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('encryption_check'); + } + + # 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 $sql = 'SELECT '.$tclass->primary_key. + ' FROM '.$table. + ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum. + ' 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