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 Locale::Country;
use FS::UID qw( dbh driver_name );
use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
use FS::Cursor;
-use FS::Misc qw( generate_email send_email generate_ps do_print money_pretty );
+use FS::Misc qw( generate_ps do_print money_pretty card_types );
use FS::Msgcat qw(gettext);
use FS::CurrentUser;
use FS::TicketSystem;
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 {
);
$cust_main->insert( \%hash );
-INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
-be set as the invoicing list (see L<"invoicing_list">). Errors return as
-expected and rollback the entire transaction; it is not necessary to call
-check_invoicing_list first. The invoicing_list is set after the records in the
-CUST_PKG_HASHREF above are inserted, so it is now possible to set an
-invoicing_list destination to the newly-created svc_acct. Here's an example:
-
- $cust_main->insert( {}, [ $email, 'POST' ] );
+INVOICING_LIST_ARYREF: No longer supported.
Currently available options are: I<depend_jobnum>, I<noexport>,
I<tax_exemption>, I<prospectnum>, I<contact> and I<contact_params>.
If I<prospectnum> is set, moves contacts and locations from that prospect.
-If I<contact> is set to an arrayref of FS::contact objects, inserts those
-new contacts with this new customer.
+If I<contact> is set to an arrayref of FS::contact objects, those will be
+inserted.
If I<contact_params> is set to a hashref of CGI parameters (and I<contact> is
unset), inserts those new contacts with this new customer. Handles CGI
sub insert {
my $self = shift;
my $cust_pkgs = @_ ? shift : {};
- my $invoicing_list = @_ ? shift : '';
+ my $invoicing_list;
+ if ( $_[0] and ref($_[0]) eq 'ARRAY' ) {
+ warn "cust_main::insert using deprecated invoicing list argument";
+ $invoicing_list = shift;
+ }
my %options = @_;
warn "$me insert called with options ".
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';
$self->auto_agent_custid()
if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
- my $error = $self->SUPER::insert;
+ my $error = $self->check_payinfo_cardtype
+ || $self->SUPER::insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
#return "inserting cust_main record (transaction rolled back): $error";
}
}
- warn " setting invoicing list\n"
- if $DEBUG > 1;
-
- if ( $invoicing_list ) {
- $error = $self->check_invoicing_list( $invoicing_list );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- #return "checking invoicing_list (transaction rolled back): $error";
- return $error;
- }
- $self->invoicing_list( $invoicing_list );
- }
-
warn " setting customer tags\n"
if $DEBUG > 1;
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"
if $DEBUG > 1;
+ $invoicing_list ||= $options{'invoicing_list'};
+ if ( $invoicing_list ) {
+
+ $invoicing_list = [ $invoicing_list ] if !ref($invoicing_list);
+
+ my $email = '';
+ foreach my $dest (@$invoicing_list ) {
+ if ($dest eq 'POST') {
+ $self->set('postal_invoice', 'Y');
+ } else {
+
+ my $contact_email = qsearchs('contact_email', { emailaddress => $dest });
+ if ( $contact_email ) {
+ my $cust_contact = FS::cust_contact->new({
+ contactnum => $contact_email->contactnum,
+ custnum => $self->custnum,
+ });
+ $cust_contact->set('invoice_dest', 'Y');
+ my $error = $cust_contact->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$error (linking to email address $dest)";
+ }
+
+ } else {
+ # this email address is not yet linked to any contact
+ $email .= ',' if length($email);
+ $email .= $dest;
+ }
+ }
+ }
+
+ 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;
+ }
+
+ }
+
+ }
+
if ( my $contact = delete $options{'contact'} ) {
foreach my $c ( @$contact ) {
warn " setting cust_payby\n"
if $DEBUG > 1;
- if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
+ if ( $options{cust_payby} ) {
+
+ foreach my $cust_payby ( @{ $options{cust_payby} } ) {
+ $cust_payby->custnum($self->custnum);
+ my $error = $cust_payby->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ } elsif ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
my $error = $self->process_o2m(
'table' => 'cust_payby',
C<ship_location>. The address will still only change if at least one of the
address fields differs from the existing values.
-INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
-be set as the invoicing list (see L<"invoicing_list">). Errors return as
-expected and rollback the entire transaction; it is not necessary to call
-check_invoicing_list first. Here's an example:
+INVOICING_LIST_ARYREF: If you pass an arrayref to this method, it will be
+set as the contact email address for a default contact with the same name as
+the customer.
- $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
-
-Currently available options are: I<tax_exemption>.
+Currently available options are: I<tax_exemption>, I<cust_payby_params>,
+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
deleted and inserted as appropriate.
+I<cust_payby_params> and I<contact_params> can be hashrefs of named parameter
+groups (describing the customer's payment methods and contacts, respectively)
+in the style supported by L<FS::o2m_Common/process_o2m>. See L<FS::cust_payby>
+and L<FS::contact> for the fields these can contain.
+
+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 {
|| $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
&& ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
+ if ( $self->payby =~ /^(CARD|DCRD)$/
+ && $old->payinfo ne $self->payinfo
+ && $old->paymask ne $self->paymask )
+ {
+ my $error = $self->check_payinfo_cardtype;
+ return $error if $error;
+ }
+
return "Invoicing locale is required"
if $old->locale
&& ! $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';
$self->set($l.'num', $new_loc->locationnum);
} #for $l
+ my $invoicing_list;
+ if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
+ warn "cust_main::replace: using deprecated invoicing list argument";
+ $invoicing_list = shift @param;
+ }
+
+ my %options = @param;
+
+ $invoicing_list ||= $options{invoicing_list};
+
+ my @contacts = map { $_->contact } $self->cust_contact;
+ # find a contact that matches the customer's name
+ my ($implicit_contact) = grep { $_->first eq $old->get('first')
+ and $_->last eq $old->get('last') }
+ @contacts;
+ $implicit_contact ||= FS::contact->new({
+ 'custnum' => $self->custnum,
+ 'locationnum' => $self->get('bill_locationnum'),
+ });
+
+ # for any of these that are already contact emails, link to the existing
+ # contact
+ if ( $invoicing_list ) {
+ my $email = '';
+
+ # kind of like process_m2m on these, except:
+ # - the other side is two tables in a join
+ # - and we might have to create new contact_emails
+ # - and possibly a new contact
+ #
+ # Find existing invoice emails that aren't on the implicit contact.
+ # Any of these that are not on the new invoicing list will be removed.
+ my %old_email_cust_contact;
+ foreach my $cust_contact ($self->cust_contact) {
+ next if !$cust_contact->invoice_dest;
+ next if $cust_contact->contactnum == ($implicit_contact->contactnum || 0);
+
+ foreach my $contact_email ($cust_contact->contact->contact_email) {
+ $old_email_cust_contact{ $contact_email->emailaddress } = $cust_contact;
+ }
+ }
+
+ foreach my $dest (@$invoicing_list) {
+
+ if ($dest eq 'POST') {
+
+ $self->set('postal_invoice', 'Y');
+
+ } elsif ( exists($old_email_cust_contact{$dest}) ) {
+
+ delete $old_email_cust_contact{$dest}; # don't need to remove it, then
+
+ } else {
+
+ # See if it belongs to some other contact; if so, link it.
+ my $contact_email = qsearchs('contact_email', { emailaddress => $dest });
+ if ( $contact_email
+ and $contact_email->contactnum != ($implicit_contact->contactnum || 0) ) {
+ my $cust_contact = qsearchs('cust_contact', {
+ contactnum => $contact_email->contactnum,
+ custnum => $self->custnum,
+ }) || FS::cust_contact->new({
+ contactnum => $contact_email->contactnum,
+ custnum => $self->custnum,
+ });
+ $cust_contact->set('invoice_dest', 'Y');
+ my $error = $cust_contact->custcontactnum ?
+ $cust_contact->replace : $cust_contact->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$error (linking to email address $dest)";
+ }
+
+ } else {
+ # This email address is not yet linked to any contact, so it will
+ # be added to the implicit contact.
+ $email .= ',' if length($email);
+ $email .= $dest;
+ }
+ }
+ }
+
+ foreach my $remove_dest (keys %old_email_cust_contact) {
+ my $cust_contact = $old_email_cust_contact{$remove_dest};
+ # These were not in the list of requested destinations, so take them off.
+ $cust_contact->set('invoice_dest', '');
+ my $error = $cust_contact->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$error (unlinking email address $remove_dest)";
+ }
+ }
+
+ # make sure it keeps up with the changed customer name, if any
+ $implicit_contact->set('last', $self->get('last'));
+ $implicit_contact->set('first', $self->get('first'));
+ $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 ) {
+ $error = $implicit_contact->replace;
+ } elsif ( length($email) ) { # don't create a new contact if not needed
+ $error = $implicit_contact->insert;
+ }
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$error (adding email address $email)";
+ }
+
+ }
+
# replace the customer record
my $error = $self->SUPER::replace($old);
$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;
}
}
- if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
- my $invoicing_list = shift @param;
- $error = $self->check_invoicing_list( $invoicing_list );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $self->invoicing_list( $invoicing_list );
- }
-
if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
#this could be more efficient than deleting and re-inserting, if it matters
}
- my %options = @param;
-
my $tax_exemption = delete $options{'tax_exemption'};
if ( $tax_exemption ) {
}
+ if ( my $contact_params = delete $options{'contact_params'} ) {
+
+ # this can potentially replace contacts that were created by the
+ # invoicing list argument, but the UI shouldn't allow both of them
+ # to be specified
+
+ my $error = $self->process_o2m(
+ 'table' => 'contact',
+ 'fields' => FS::contact->cgi_contact_fields,
+ 'params' => $contact_params,
+ );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ }
+
unless ( $import || $skip_fuzzyfiles ) {
$error = $self->queue_fuzzyfiles_update;
if ( $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')
;
foreach (qw(company ship_company)) {
}
- ### 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);
$self->SUPER::check;
}
+sub check_payinfo_cardtype {
+ my $self = shift;
+
+ return '' unless $self->payby =~ /^(CARD|DCRD)$/;
+
+ my $payinfo = $self->payinfo;
+ $payinfo =~ s/\D//g;
+
+ return '' if $self->tokenized($payinfo); #token
+
+ my %bop_card_types = map { $_=>1 } values %{ card_types() };
+ my $cardtype = cardtype($payinfo);
+
+ return "$cardtype not accepted" unless $bop_card_types{$cardtype};
+
+ '';
+
+}
+
=item replace_check
Additional checks for replace only.
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
qsearch('cust_contact', { 'custnum' => $self->custnum } );
}
-=item cust_payby
+=item cust_payby PAYBY
Returns all payment methods (see L<FS::cust_payby>) for this customer.
+If one or more PAYBY are specified, returns only payment methods for specified PAYBY.
+Does not validate PAYBY.
+
=cut
sub cust_payby {
my $self = shift;
- qsearch({
+ my @payby = @_;
+ my $search = {
'table' => '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).
+ ' ) '
+ if @payby;
+
+ qsearch($search);
}
+=item has_cust_payby_auto
+
+Returns true if customer has an automatic payment method ('CARD' or 'CHEK')
+
+=cut
+
sub has_cust_payby_auto {
my $self = shift;
scalar( qsearch({
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" );
+ }
}
-
- warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
- scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
+ 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;
+ }
- grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
-}
-
-sub _banned_pay_hashref {
- my $self = shift;
+ warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ".
+ $self->custnum. "\n"
+ if $DEBUG;
- my %payby2ban = (
- 'CARD' => 'CARD',
- 'DCRD' => 'CARD',
+ 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 = (
+ 'CARD' => 'CARD',
+ 'DCRD' => 'CARD',
'CHEK' => 'CHEK',
'DCHK' => 'CHEK'
);
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_monthyear
-
-Returns a two-element list consisting of the month and year of this customer's
-paydate (credit card expiration date for CARD customers)
-
-=cut
-
-sub paydate_monthyear {
- my $self = shift;
- if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
- ( $2, $1 );
- } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
- ( $1, $3 );
- } else {
- ('', '');
- }
-}
-
=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 ) = @_;
=item cust_main_exemption
-=item invoicing_list [ ARRAYREF ]
-
-If an arguement is given, sets these email addresses as invoice recipients
-(see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
-(except as warnings), so use check_invoicing_list first.
+=item invoicing_list
-Returns a list of email addresses (with svcnum entries expanded).
-
-Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
-check it without disturbing anything by passing nothing.
-
-This interface may change in the future.
+Returns a list of email addresses (with svcnum entries expanded), and the word
+'POST' if the customer receives postal invoices.
=cut
my( $self, $arrayref ) = @_;
if ( $arrayref ) {
- my @cust_main_invoice;
- if ( $self->custnum ) {
- @cust_main_invoice =
- qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
- } else {
- @cust_main_invoice = ();
- }
- foreach my $cust_main_invoice ( @cust_main_invoice ) {
- #warn $cust_main_invoice->destnum;
- unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
- #warn $cust_main_invoice->destnum;
- my $error = $cust_main_invoice->delete;
- warn $error if $error;
- }
- }
- if ( $self->custnum ) {
- @cust_main_invoice =
- qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
- } else {
- @cust_main_invoice = ();
- }
- my %seen = map { $_->address => 1 } @cust_main_invoice;
- foreach my $address ( @{$arrayref} ) {
- next if exists $seen{$address} && $seen{$address};
- $seen{$address} = 1;
- my $cust_main_invoice = new FS::cust_main_invoice ( {
- 'custnum' => $self->custnum,
- 'dest' => $address,
- } );
- my $error = $cust_main_invoice->insert;
- warn $error if $error;
- }
+ warn "FS::cust_main::invoicing_list(ARRAY) is no longer supported.";
}
- if ( $self->custnum ) {
- map { $_->address }
- qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
- } else {
- ();
- }
+ my @emails = $self->invoicing_list_emailonly;
+ push @emails, 'POST' if $self->get('postal_invoice');
+ @emails;
}
=item check_invoicing_list ARRAYREF
'';
}
-=item set_default_invoicing_list
-
-Sets the invoicing list to all accounts associated with this customer,
-overwriting any previous invoicing list.
-
-=cut
-
-sub set_default_invoicing_list {
- my $self = shift;
- $self->invoicing_list($self->all_emails);
-}
-
=item all_emails
Returns the email addresses of all accounts provisioned for this customer.
sub invoicing_list_addpost {
my $self = shift;
- return if grep { $_ eq 'POST' } $self->invoicing_list;
- my @invoicing_list = $self->invoicing_list;
- push @invoicing_list, 'POST';
- $self->invoicing_list(\@invoicing_list);
+ if ( $self->get('postal_invoice') eq '' ) {
+ $self->set('postal_invoice', 'Y');
+ my $error = $self->replace;
+ warn $error if $error; # should fail harder, but this is traditional
+ }
}
=item invoicing_list_emailonly
my $self = shift;
warn "$me invoicing_list_emailonly called"
if $DEBUG;
- grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
+ return () if !$self->custnum; # not yet inserted
+ return map { $_->emailaddress }
+ qsearch({
+ table => 'cust_contact',
+ select => 'emailaddress',
+ addl_from => ' JOIN contact USING (contactnum) '.
+ ' JOIN contact_email USING (contactnum)',
+ hashref => { 'custnum' => $self->custnum, },
+ extra_sql => q( AND cust_contact.invoice_dest = 'Y'),
+ });
}
=item invoicing_list_emailonly_scalar
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'
$contact->get('first') . ' '. $contact->get('last');
}
-#XXX this doesn't work in 3.x+
-#=item country_full
-#
-#Returns this customer's full country name
-#
-#=cut
-#
-#sub country_full {
-# my $self = shift;
-# code2country($self->country);
-#}
-
sub bill_country_full {
my $self = shift;
- code2country($self->bill_location->country);
+ $self->bill_location->country_full;
}
sub ship_country_full {
my $self = shift;
- code2country($self->ship_location->country);
+ $self->ship_location->country_full;
}
=item county_state_county [ PREFIX ]
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;
+ }
}
}
(@tickets);
}
+=item appointments [ STATUS ]
+
+Returns an array of hashes representing the customer's RT tickets which
+are appointments.
+
+=cut
+
+sub appointments {
+ my $self = shift;
+ my $status = ( @_ && $_[0] ) ? shift : '';
+
+ return () unless $conf->config('ticket_system');
+
+ my $queueid = $conf->config('ticket_system-appointment-queueid');
+
+ @{ FS::TicketSystem->customer_tickets( $self->custnum,
+ 99,
+ undef,
+ $status,
+ $queueid,
+ )
+ };
+}
+
# Return services representing svc_accts in customer support packages
sub support_services {
my $self = shift;
return @out;
}
+=item save_cust_payby
+
+Saves a new cust_payby for this customer, replacing an existing entry only
+in select circumstances. Does not validate input.
+
+If auto is specified, marks this as the customer's primary method, or the
+specified weight. Existing payment methods have their weight incremented as
+appropriate.
+
+If bill_location is specified with auto, also sets location in cust_main.
+
+Will not insert complete duplicates of existing records, or records in which the
+only difference from an existing record is to turn off automatic payment (will
+return without error.) Will replace existing records in which the only difference
+is to add a value to a previously empty preserved field and/or turn on automatic payment.
+Fields marked as preserved are optional, and existing values will not be overwritten with
+blanks when replacing.
+
+Accepts the following named parameters:
+
+=over 4
+
+=item payment_payby
+
+either CARD or CHEK
+
+=item auto
+
+save as an automatic payment type (CARD/CHEK if true, DCRD/DCHK if false)
+
+=item weight
+
+optional, set higher than 1 for secondary, etc.
+
+=item payinfo
+
+required
+
+=item paymask
+
+optional, but should be specified for anything that might be tokenized, will be preserved when replacing
+
+=item payname
+
+required
+
+=item payip
+
+optional, will be preserved when replacing
+
+=item paydate
+
+CARD only, required
+
+=item bill_location
+
+CARD only, required, FS::cust_location object
+
+=item paystart_month
+
+CARD only, optional, will be preserved when replacing
+
+=item paystart_year
+
+CARD only, optional, will be preserved when replacing
+
+=item payissue
+
+CARD only, optional, will be preserved when replacing
+
+=item paycvv
+
+CARD only, only used if conf cvv-save is set appropriately
+
+=item paytype
+
+CHEK only
+
+=item paystate
+
+CHEK only
+
+=item saved_cust_payby
+
+scalar reference, for returning saved object
+
+=back
+
+=cut
+
+#The code for this option is in place, but it's not currently used
+#
+# =item replace
+#
+# existing cust_payby object to be replaced (must match custnum)
+
+# stateid/stateid_state/ss are not currently supported in cust_payby,
+# might not even work properly in 4.x, but will need to work here if ever added
+
+sub save_cust_payby {
+ my $self = shift;
+ my %opt = @_;
+
+ my $old = $opt{'replace'};
+ my $new = new FS::cust_payby { $old ? $old->hash : () };
+ return "Customer number does not match" if $new->custnum and $new->custnum != $self->custnum;
+ $new->set( 'custnum' => $self->custnum );
+
+ my $payby = $opt{'payment_payby'};
+ return "Bad payby" unless grep(/^$payby$/,('CARD','CHEK'));
+
+ # don't allow turning off auto when replacing
+ $opt{'auto'} ||= 1 if $old and $old->payby !~ /^D/;
+
+ my @check_existing; # payby relevant to this payment_payby
+
+ # set payby based on auto
+ if ( $payby eq 'CARD' ) {
+ $new->set( 'payby' => ( $opt{'auto'} ? 'CARD' : 'DCRD' ) );
+ @check_existing = qw( CARD DCRD );
+ } elsif ( $payby eq 'CHEK' ) {
+ $new->set( 'payby' => ( $opt{'auto'} ? 'CHEK' : 'DCHK' ) );
+ @check_existing = qw( CHEK DCHK );
+ }
+
+ $new->set( 'weight' => $opt{'auto'} ? $opt{'weight'} : '' );
+
+ # basic fields
+ $new->payinfo($opt{'payinfo'}); # sets default paymask, but not if it's already tokenized
+ $new->paymask($opt{'paymask'}) if $opt{'paymask'}; # in case it's been tokenized, override with loaded paymask
+ $new->set( 'payname' => $opt{'payname'} );
+ $new->set( 'payip' => $opt{'payip'} ); # will be preserved below
+
+ my $conf = new FS::Conf;
+
+ # 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'))
+ || $conf->exists('business-onlinepayment-verification')
+ )
+ ) {
+ $new->set( 'paycvv' => $opt{'paycvv'} );
+ } else {
+ $new->set( 'paycvv' => '');
+ }
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ # set fields specific to payment_payby
+ if ( $payby eq 'CARD' ) {
+ if ($opt{'bill_location'}) {
+ $opt{'bill_location'}->set('custnum' => $self->custnum);
+ my $error = $opt{'bill_location'}->find_or_insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ $new->set( 'locationnum' => $opt{'bill_location'}->locationnum );
+ }
+ foreach my $field ( qw( paydate paystart_month paystart_year payissue ) ) {
+ $new->set( $field => $opt{$field} );
+ }
+ } else {
+ foreach my $field ( qw(paytype paystate) ) {
+ $new->set( $field => $opt{$field} );
+ }
+ }
+
+ # other cust_payby to compare this to
+ my @existing = $self->cust_payby(@check_existing);
+
+ # fields that can overwrite blanks with values, but not values with blanks
+ my @preserve = qw( paymask locationnum paystart_month paystart_year payissue payip );
+
+ my $skip_cust_payby = 0; # true if we don't need to save or reweight cust_payby
+ unless ($old) {
+ # generally, we don't want to overwrite existing cust_payby with this,
+ # but we can replace if we're only marking it auto or adding a preserved field
+ # and we can avoid saving a total duplicate or merely turning off auto
+PAYBYLOOP:
+ foreach my $cust_payby (@existing) {
+ # check fields that absolutely should not change
+ foreach my $field ($new->fields) {
+ 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;
+ foreach my $field (@preserve) {
+ if (
+ ( $new->get($field) and !$cust_payby->get($field) ) or
+ ( $cust_payby->get($field) and !$new->get($field) )
+ ) {
+ # prevention of overwriting values with blanks happens farther below
+ $replace = 1;
+ } elsif ( $new->get($field) ne $cust_payby->get($field) ) {
+ next PAYBYLOOP;
+ }
+ }
+ unless ( $replace ) {
+ # nearly identical, now check weight
+ if ($new->get('weight') eq $cust_payby->get('weight') or !$new->get('weight')) {
+ # ignore identical cust_payby, and ignore attempts to turn off auto
+ # no need to save or re-weight cust_payby (but still need to update/commit $self)
+ $skip_cust_payby = 1;
+ last PAYBYLOOP;
+ }
+ # otherwise, only change is to mark this as primary
+ }
+ # if we got this far, we're definitely replacing
+ $old = $cust_payby;
+ last PAYBYLOOP;
+ } #PAYBYLOOP
+ }
+
+ if ($old) {
+ $new->set( 'custpaybynum' => $old->custpaybynum );
+ # don't turn off automatic payment (but allow it to be turned on)
+ if ($new->payby =~ /^D/ and $new->payby ne $old->payby) {
+ $opt{'auto'} = 1;
+ $new->set( 'payby' => $old->payby );
+ $new->set( 'weight' => 1 );
+ }
+ # make sure we're not overwriting values with blanks
+ foreach my $field (@preserve) {
+ if ( $old->get($field) and !$new->get($field) ) {
+ $new->set( $field => $old->get($field) );
+ }
+ }
+ }
+
+ # only overwrite cust_main bill_location if auto
+ if ($opt{'auto'} && $opt{'bill_location'}) {
+ $self->set('bill_location' => $opt{'bill_location'});
+ my $error = $self->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ # done with everything except reweighting and saving cust_payby
+ # still need to commit changes to cust_main and cust_location
+ if ($skip_cust_payby) {
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return '';
+ }
+
+ # re-weight existing primary cust_pay for this payby
+ if ($opt{'auto'}) {
+ foreach my $cust_payby (@existing) {
+ # relies on cust_payby return order
+ last unless $cust_payby->payby !~ /^D/;
+ last if $cust_payby->weight > 1;
+ next if $new->custpaybynum eq $cust_payby->custpaybynum;
+ next if $cust_payby->weight < ($opt{'weight'} || 1);
+ $cust_payby->weight( $cust_payby->weight + 1 );
+ my $error = $cust_payby->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error reweighting cust_payby: $error";
+ }
+ }
+ }
+
+ # finally, save cust_payby
+ my $error = $old ? $new->replace($old) : $new->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ 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;
+ $class->_upgrade_otaker(%opts);
- my @payfields = qw( payby payinfo paycvv paymask
- paydate paystart_month paystart_year payissue
- payname paystate paytype payip
- );
+ # 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();
+ }
- my $search = new FS::Cursor {
- 'table' => 'cust_main',
- 'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ",
- };
+}
- while (my $cust_main = $search->fetch) {
+sub queueable_upgrade {
+ my $class = shift;
- unless ( $cust_main->payby =~ /^(BILL|COMP)$/ ) {
+ ### 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 $cust_payby = new FS::cust_payby {
- 'custnum' => $cust_main->custnum,
- 'weight' => 1,
- map { $_ => $cust_main->$_(); } @payfields
- };
+ # fix Tokenized paycardtype and encrypt old records
+ if ( ! FS::upgrade_journal->is_done('paycardtype_Tokenized')
+ || ! FS::upgrade_journal->is_done('encryption_check')
+ )
+ {
- my $error = $cust_payby->insert;
- die $error if $error;
+ # 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;
- $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