FS::cust_main::Credit_Limit
FS::cust_main::Merge
FS::cust_main::API
- FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
+ FS::otaker_Mixin FS::cust_main_Mixin
FS::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin
FS::o2m_Common
FS::Record
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 );
use FS::sales;
use FS::cust_payby;
use FS::contact;
+use FS::reason;
+use FS::Misc::Savepoint;
# 1 is mostly method/subroutine entry and options
# 2 traces progress of some operations
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 {
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';
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
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"
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)";
}
}
- 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;
+ }
+
}
}
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;
|| $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')
}
- ### start of stuff moved to cust_payby
- # then mostly kept here to support upgrades (can remove in 5.x)
- # but modified to allow everything to be empty
-
- if ( $self->payby ) {
- FS::payby->can_payby($self->table, $self->payby)
- or return "Illegal payby: ". $self->payby;
- } else {
- $self->payby('');
- }
-
- $error = $self->ut_numbern('paystart_month')
- || $self->ut_numbern('paystart_year')
- || $self->ut_numbern('payissue')
- || $self->ut_textn('paytype')
- ;
- return $error if $error;
-
- if ( $self->payip eq '' ) {
- $self->payip('');
- } else {
- $error = $self->ut_ip('payip');
- return $error if $error;
- }
-
- # If it is encrypted and the private key is not availaible then we can't
- # check the credit card.
- my $check_payinfo = ! $self->is_encrypted($self->payinfo);
-
- # Need some kind of global flag to accept invalid cards, for testing
- # on scrubbed data.
- if ( !$import && !$ignore_invalid_card && $check_payinfo &&
- $self->payby =~ /^(CARD|DCRD)$/ ) {
-
- my $payinfo = $self->payinfo;
- $payinfo =~ s/\D//g;
- $payinfo =~ /^(\d{13,16}|\d{8,9})$/
- or return gettext('invalid_card'); # . ": ". $self->payinfo;
- $payinfo = $1;
- $self->payinfo($payinfo);
- 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";
-
- unless ( $ignore_banned_card ) {
- my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
- if ( $ban ) {
- if ( $ban->bantype eq 'warn' ) {
- #or others depending on value of $ban->reason ?
- return '_duplicate_card'.
- ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
- ' until '. time2str('%a %h %o at %r', $ban->_end_date).
- ' (ban# '. $ban->bannum. ')'
- unless $self->override_ban_warn;
- } else {
- return 'Banned credit card: banned on '.
- time2str('%a %h %o at %r', $ban->_date).
- ' by '. $ban->otaker.
- ' (ban# '. $ban->bannum. ')';
- }
- }
- }
-
- if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
- if ( cardtype($self->payinfo) eq 'American Express card' ) {
- $self->paycvv =~ /^(\d{4})$/
- or return "CVV2 (CID) for American Express cards is four digits.";
- $self->paycvv($1);
- } else {
- $self->paycvv =~ /^(\d{3})$/
- or return "CVV2 (CVC2/CID) is three digits.";
- $self->paycvv($1);
- }
- } else {
- $self->paycvv('');
- }
-
- my $cardtype = cardtype($payinfo);
- if ( $cardtype =~ /^(Switch|Solo)$/i ) {
-
- return "Start date or issue number is required for $cardtype cards"
- unless $self->paystart_month && $self->paystart_year or $self->payissue;
-
- return "Start month must be between 1 and 12"
- if $self->paystart_month
- and $self->paystart_month < 1 || $self->paystart_month > 12;
-
- return "Start year must be 1990 or later"
- if $self->paystart_year
- and $self->paystart_year < 1990;
-
- return "Issue number must be beween 1 and 99"
- if $self->payissue
- and $self->payissue < 1 || $self->payissue > 99;
-
- } else {
- $self->paystart_month('');
- $self->paystart_year('');
- $self->payissue('');
- }
-
- } elsif ( !$ignore_invalid_card && $check_payinfo &&
- $self->payby =~ /^(CHEK|DCHK)$/ ) {
-
- my $payinfo = $self->payinfo;
- $payinfo =~ s/[^\d\@\.]//g;
- if ( $conf->config('echeck-country') eq 'CA' ) {
- $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
- or return 'invalid echeck account@branch.bank';
- $payinfo = "$1\@$2.$3";
- } elsif ( $conf->config('echeck-country') eq 'US' ) {
- $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
- $payinfo = "$1\@$2";
- } else {
- $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
- $payinfo = "$1\@$2";
- }
- $self->payinfo($payinfo);
- $self->paycvv('');
-
- unless ( $ignore_banned_card ) {
- my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
- if ( $ban ) {
- if ( $ban->bantype eq 'warn' ) {
- #or others depending on value of $ban->reason ?
- return '_duplicate_ach' unless $self->override_ban_warn;
- } else {
- return 'Banned ACH account: banned on '.
- time2str('%a %h %o at %r', $ban->_date).
- ' by '. $ban->otaker.
- ' (ban# '. $ban->bannum. ')';
- }
- }
- }
-
- } elsif ( $self->payby eq 'LECB' ) {
-
- my $payinfo = $self->payinfo;
- $payinfo =~ s/\D//g;
- $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
- $payinfo = $1;
- $self->payinfo($payinfo);
- $self->paycvv('');
-
- } elsif ( $self->payby eq 'BILL' ) {
-
- $error = $self->ut_textn('payinfo');
- return "Illegal P.O. number: ". $self->payinfo if $error;
- $self->paycvv('');
-
- } elsif ( $self->payby eq 'COMP' ) {
-
- my $curuser = $FS::CurrentUser::CurrentUser;
- if ( ! $self->custnum
- && ! $curuser->access_right('Complimentary customer')
- )
- {
- return "You are not permitted to create complimentary accounts."
- }
-
- $error = $self->ut_textn('payinfo');
- return "Illegal comp account issuer: ". $self->payinfo if $error;
- $self->paycvv('');
-
- } elsif ( $self->payby eq 'PREPAY' ) {
-
- my $payinfo = $self->payinfo;
- $payinfo =~ s/\W//g; #anything else would just confuse things
- $self->payinfo($payinfo);
- $error = $self->ut_alpha('payinfo');
- return "Illegal prepayment identifier: ". $self->payinfo if $error;
- return "Unknown prepayment identifier"
- unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
- $self->paycvv('');
-
- }
-
- return "You are not permitted to create complimentary accounts."
- if ! $self->custnum
- && $self->complimentary eq 'Y'
- && ! $FS::CurrentUser::CurrentUser->access_right('Complimentary customer');
-
- if ( $self->paydate eq '' || $self->paydate eq '-' ) {
- return "Expiration date required"
- # shouldn't payinfo_check do this?
- unless ! $self->payby
- || $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
- $self->paydate('');
- } else {
- my( $m, $y );
- if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
- ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
- } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
- ( $m, $y ) = ( $2, "19$1" );
- } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
- ( $m, $y ) = ( $3, "20$2" );
- } else {
- return "Illegal expiration date: ". $self->paydate;
- }
- $m = sprintf('%02d',$m);
- $self->paydate("$y-$m-01");
- my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
- return gettext('expired_card')
- if !$import
- && !$ignore_expired_card
- && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
- }
-
- if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
- ( ! $conf->exists('require_cardname')
- || $self->payby !~ /^(CARD|DCRD)$/ )
- ) {
- $self->payname( $self->first. " ". $self->getfield('last') );
- } else {
-
- if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
- $self->payname =~ /^([\w \,\.\-\']*)$/
- or return gettext('illegal_name'). " payname: ". $self->payname;
- $self->payname($1);
- } else {
- $self->payname =~ /^([\w \,\.\-\'\&]*)$/
- or return gettext('illegal_name'). " payname: ". $self->payname;
- $self->payname($1);
- }
-
- }
-
- ### end of stuff moved to cust_payby
-
return "Please select an invoicing locale"
if ! $self->locale
&& ! $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);
sub check_payinfo_cardtype {
my $self = shift;
- return '' unless $self->payby =~ /^(CARD|CHEK)$/;
+ return '' unless $self->payby =~ /^(CARD|DCRD)$/;
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 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
'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);
sub unsuspend {
my $self = shift;
- grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
+ grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs(@_);
}
=item release_hold
=item cancel [ OPTION => VALUE ... ]
Cancels all uncancelled packages (see L<FS::cust_pkg>) 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<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>, reason - Text of the new reason.
+=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>)
+reason - Text of the new reason.
+
+=item cust_pkg_reason - can be an arrayref of L<FS::cust_pkg_reason> objects
+for the individual packages, parallel to the C<cust_pkg> 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
+ # unless exports are suppressed
+ die "cancel_pkgs cannot be run inside a transaction"
+ 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;
- return ( $error ) if $error;
+ if ($error) {
+ savepoint_rollback_and_release('cancel_pkgs');
+ dbh->rollback if $oldAutoCommit;
+ 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";
+ savepoint_rollback_and_release('cancel_pkgs');
+ dbh->rollback if $oldAutoCommit;
+ return ( "Error billing during cancellation: $error" );
+ }
+ }
+ savepoint_release('cancel_pkgs');
+ dbh->commit if $oldAutoCommit;
+
+ 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;
+ 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 ) {
+ savepoint_rollback_and_release( $savepoint );
+ dbh->rollback if $oldAutoCommit;
+ push @errors, $error;
+ } else {
+ savepoint_release( $savepoint );
+ dbh->commit if $oldAutoCommit;
+ }
+ }
+ 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;
+ $i = 0;
+ foreach (@pkgs) {
+ my %lopt = %opt;
+ my $savepoint = 'cancel_pkgs_'.$i++;
+ savepoint_create( $savepoint );
+ 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 ) {
+ savepoint_rollback_and_release( $savepoint );
+ dbh->rollback if $oldAutoCommit;
+ push @errors, 'pkgnum '.$_->pkgnum.': '.$error;
+ } else {
+ savepoint_release( $savepoint );
+ dbh->commit if $oldAutoCommit;
+ }
+ }
+
+ return @errors;
}
sub _banned_pay_hashref {
+ die 'cust_main->_banned_pay_hashref deprecated';
+
my $self = shift;
my %payby2ban = (
If there is an error, returns the error, otherwise returns false.
+DEPRECATED. Use L</remove_cvv_from_cust_payby> instead.
+
=cut
sub remove_cvv {
+ die 'cust_main->remove_cvv deprecated';
my $self = shift;
my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
or return dbh->errstr;
=cut
+#XXX i need to be updated for 4.x+
sub payment_info {
my $self = shift;
=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
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
-# 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 ) = @_;
join(', ', $self->invoicing_list_emailonly);
}
+=item contact_list [ CLASSNUM, DEST_FLAG... ]
+
+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 => 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,
+ };
+
+ # 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;
+ 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 {
+ croak "bad classnum argument '$_'";
+ }
+ }
+
+ 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);
+}
+
+=item contact_list_email [ CLASSNUM, ... ]
+
+Same as L</contact_list>, 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
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.
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
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;
}
$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'
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;
+ }
}
}
CHEK only
+=item saved_cust_payby
+
+scalar reference, for returning saved object
+
=back
=cut
# 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' => '');
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;
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
=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
=over 4
-#=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
-
-#Deprecated. Use event notification and message templates
-#(L<FS::msg_template>) instead.
-
-#Sends a templated email notification to the customer (see L<Text::Template>).
-
-#OPTIONS is a hash and may include
-
-#I<from> - the email sender (default is invoice_from)
-
-#I<to> - comma-separated scalar or arrayref of recipients
-# (default is invoicing_list)
-
-#I<subject> - The subject line of the sent email notification
-# (default is "Notice from company_name")
-
-#I<extra_fields> - a hashref of name/value pairs which will be substituted
-# into the template
-
-#The following variables are vavailable in the template.
-
-#I<$first> - the customer first name
-#I<$last> - the customer last name
-#I<$company> - the customer company
-#I<$payby> - a description of the method of payment for the customer
-# # would be nice to use FS::payby::shortname
-#I<$payinfo> - the account information used to collect for this customer
-#I<$expdate> - the expiration of the customer payment in seconds from epoch
-
-#=cut
-
-#sub notify {
-# my ($self, $template, %options) = @_;
-
-# return unless $conf->exists($template);
-
-# my $from = $conf->invoice_from_full($self->agentnum)
-# if $conf->exists('invoice_from', $self->agentnum);
-# $from = $options{from} if exists($options{from});
-
-# my $to = join(',', $self->invoicing_list_emailonly);
-# $to = $options{to} if exists($options{to});
-#
-# my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
-# if $conf->exists('company_name', $self->agentnum);
-# $subject = $options{subject} if exists($options{subject});
-
-# my $notify_template = new Text::Template (TYPE => 'ARRAY',
-# SOURCE => [ map "$_\n",
-# $conf->config($template)]
-# )
-# or die "can't create new Text::Template object: Text::Template::ERROR";
-# $notify_template->compile()
-# or die "can't compile template: Text::Template::ERROR";
-
-# $FS::notify_template::_template::company_name =
-# $conf->config('company_name', $self->agentnum);
-# $FS::notify_template::_template::company_address =
-# join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
-
-# my $paydate = $self->paydate || '2037-12-31';
-# $FS::notify_template::_template::first = $self->first;
-# $FS::notify_template::_template::last = $self->last;
-# $FS::notify_template::_template::company = $self->company;
-# $FS::notify_template::_template::payinfo = $self->mask_payinfo;
-# my $payby = $self->payby;
-# my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
-# my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
-
-# #credit cards expire at the end of the month/year of their exp date
-# if ($payby eq 'CARD' || $payby eq 'DCRD') {
-# $FS::notify_template::_template::payby = 'credit card';
-# ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
-# $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
-# $expire_time--;
-# }elsif ($payby eq 'COMP') {
-# $FS::notify_template::_template::payby = 'complimentary account';
-# }else{
-# $FS::notify_template::_template::payby = 'current method';
-# }
-# $FS::notify_template::_template::expdate = $expire_time;
-
-# for (keys %{$options{extra_fields}}){
-# no strict "refs";
-# ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
-# }
-
-# send_email(from => $from,
-# to => $to,
-# subject => $subject,
-# body => $notify_template->fill_in( PACKAGE =>
-# 'FS::notify_template::_template' ),
-# );
-
-#}
-
=item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
Generates a templated notification to the customer (see L<Text::Template>).
The following variables are available in the template instead of or in addition
to the fields of the customer record.
-I<$payby> - a description of the method of payment for the customer
- # would be nice to use FS::payby::shortname
-I<$payinfo> - the masked account information used to collect for this customer
-I<$expdate> - the expiration of the customer payment method in seconds from epoch
I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
=cut
or die "can't compile template: Text::Template::ERROR";
my %letter_data = map { $_ => $self->$_ } $self->fields;
- $letter_data{payinfo} = $self->mask_payinfo;
-
- #my $paydate = $self->paydate || '2037-12-31';
- my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
-
- my $payby = $self->payby;
- my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
- my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
-
- #credit cards expire at the end of the month/year of their exp date
- if ($payby eq 'CARD' || $payby eq 'DCRD') {
- $letter_data{payby} = 'credit card';
- ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
- $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
- $expire_time--;
- }elsif ($payby eq 'COMP') {
- $letter_data{payby} = 'complimentary account';
- }else{
- $letter_data{payby} = 'current method';
- }
- $letter_data{expdate} = $expire_time;
for (keys %{$options{extra_fields}}){
$letter_data{$_} = $options{extra_fields}->{$_};
$cust_main->bill_and_collect( %$param );
}
+=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'" );
+}
+
#starting to take quite a while for big dbs
# (JRNL: journaled so it only happens once per database)
# - seq scan of h_cust_main (yuck), but not going to index paycvv, so
sub _upgrade_data { #class method
my ($class, %opts) = @_;
- my @statements = (
- 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
- );
+ my @statements = ();
#this seems to be the only expensive one.. why does it take so long?
unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
FS::upgrade_journal->set_done('cust_main__signupdate');
}
- unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
-
- # fix yyyy-m-dd formatted paydates
- if ( driver_name =~ /^mysql/i ) {
- push @statements,
- "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
- } else { # the SQL standard
- push @statements,
- "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
- }
- FS::upgrade_journal->set_done('cust_main__paydate');
- }
-
- unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
-
- push @statements, #fix the weird BILL with a cc# in payinfo problem
- #DCRD to be safe
- "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
-
- FS::upgrade_journal->set_done('cust_main__payinfo');
-
- }
-
my $t = time;
foreach my $sql ( @statements ) {
my $sth = dbh->prepare($sql) or die dbh->errstr;
}
- unless ( FS::upgrade_journal->is_done('cust_main__cust_payby') ) {
-
- #we don't want to decrypt them, just stuff them as-is into cust_payby
- local(@encrypted_fields) = ();
-
- local($FS::cust_payby::ignore_expired_card) = 1;
- local($FS::cust_payby::ignore_banned_card) = 1;
-
- my @payfields = qw( payby payinfo paycvv paymask
- paydate paystart_month paystart_year payissue
- payname paystate paytype payip
- );
+ $class->_upgrade_otaker(%opts);
- my $search = new FS::Cursor {
- 'table' => 'cust_main',
- 'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ",
- };
+ # 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();
+ }
- while (my $cust_main = $search->fetch) {
+}
- unless ( $cust_main->payby =~ /^(BILL|COMP)$/ ) {
+sub queueable_upgrade {
+ my $class = shift;
- my $cust_payby = new FS::cust_payby {
- 'custnum' => $cust_main->custnum,
- 'weight' => 1,
- map { $_ => $cust_main->$_(); } @payfields
- };
+ ### 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');
+ }
- my $error = $cust_payby->insert;
- die $error if $error;
+ # 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;
- # at the time we do this, also migrate paytype into cust_pay_batch
- # so that batches that are open before the migration can still be
- # processed
- my @cust_pay_batch = qsearch('cust_pay_batch', {
- 'custnum' => $cust_main->custnum,
- 'payby' => 'CHEK',
- 'paytype' => '',
- });
- foreach my $cust_pay_batch (@cust_pay_batch) {
- $cust_pay_batch->set('paytype', $cust_main->get('paytype'));
- my $error = $cust_pay_batch->replace;
- die "$error (setting cust_pay_batch.paytype)" if $error;
- }
+ # because it looks like nothing's changing
+ local $FS::Record::no_update_diff = 1;
- $cust_main->complimentary('Y') if $cust_main->payby eq 'COMP';
+ # commit everything immediately
+ local $FS::UID::AutoCommit = 1;
- $cust_main->invoice_attn( $cust_main->payname )
- if $cust_main->payby eq 'BILL' && $cust_main->payname;
- $cust_main->po_number( $cust_main->payinfo )
- if $cust_main->payby eq 'BILL' && $cust_main->payinfo;
+ # 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';
- $cust_main->setfield($_, '') foreach @payfields;
- my $error = $cust_main->replace;
- die "Error upgradging payment information for custnum ".
- $cust_main->custnum. ": $error"
- if $error;
+ 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('cust_main__cust_payby');
+ FS::upgrade_journal->set_done('paycardtype_Tokenized');
+ FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption');
}
- $class->_upgrade_otaker(%opts);
-
+ # 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
No multiple currency support (probably a larger project than just this module).
-payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
-
Birthdates rely on negative epoch values.
-The payby for card/check batches is broken. With mixed batching, bad
-things will happen.
-
B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
=head1 SEE ALSO
=cut
1;
-
projects / freeside.git / blobdiff