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
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';
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;
sub unsuspend {
my $self = shift;
- grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
+ grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs(@_);
}
=item release_hold
my( $self, %opt ) = @_;
# we're going to cancel services, which is not reversible
+ # unless exports are suppressed
die "cancel_pkgs cannot be run inside a transaction"
- if $FS::UID::AutoCommit == 0;
+ if !$FS::UID::AutoCommit && !$FS::svc_Common::noexport_hack;
+ my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
+ savepoint_create('cancel_pkgs');
+
return ( 'access denied' )
unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
my $error = $ban->insert;
if ($error) {
- dbh->rollback;
+ savepoint_rollback_and_release('cancel_pkgs');
+ dbh->rollback if $oldAutoCommit;
return ( $error );
}
'time' => $cancel_time );
if ($error) {
warn "Error billing during cancel, custnum ". $self->custnum. ": $error";
- dbh->rollback;
+ savepoint_rollback_and_release('cancel_pkgs');
+ dbh->rollback if $oldAutoCommit;
return ( "Error billing during cancellation: $error" );
}
}
- dbh->commit;
+ savepoint_release('cancel_pkgs');
+ dbh->commit if $oldAutoCommit;
my @errors;
# try to cancel each service, the same way we would for individual packages,
warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ".
$self->custnum."\n"
if $DEBUG;
+ my $i = 0;
foreach my $cust_svc (@sorted_cust_svc) {
+ my $savepoint = 'cancel_pkgs_'.$i++;
+ savepoint_create( $savepoint );
my $part_svc = $cust_svc->part_svc;
next if ( defined($part_svc) and $part_svc->preserve );
# immediate cancel, no date option
# transactionize individually
my $error = try { $cust_svc->cancel } catch { $_ };
if ( $error ) {
- dbh->rollback;
+ savepoint_rollback_and_release( $savepoint );
+ dbh->rollback if $oldAutoCommit;
push @errors, $error;
} else {
- dbh->commit;
+ savepoint_release( $savepoint );
+ dbh->commit if $oldAutoCommit;
}
}
if (@errors) {
@cprs = @{ delete $opt{'cust_pkg_reason'} };
}
my $null_reason;
+ $i = 0;
foreach (@pkgs) {
my %lopt = %opt;
+ my $savepoint = 'cancel_pkgs_'.$i++;
+ savepoint_create( $savepoint );
if (@cprs) {
my $cpr = shift @cprs;
if ( $cpr ) {
}
my $error = $_->cancel(%lopt);
if ( $error ) {
- dbh->rollback;
+ savepoint_rollback_and_release( $savepoint );
+ dbh->rollback if $oldAutoCommit;
push @errors, 'pkgnum '.$_->pkgnum.': '.$error;
} else {
- dbh->commit;
+ savepoint_release( $savepoint );
+ dbh->commit if $oldAutoCommit;
}
}
join(', ', $self->invoicing_list_emailonly);
}
-=item contact_list [ CLASSNUM, ... ]
+=item contact_list [ CLASSNUM, DEST_FLAG... ]
-Returns a list of contacts (L<FS::contact> objects) for the customer. If
-a list of contact classnums is given, returns only contacts in those
-classes. If the pseudo-classnum 'invoice' is given, returns contacts that
-are marked as invoice destinations. If '0' is given, also returns contacts
-with no class.
+Returns a list of contacts (L<FS::contact> objects) for the customer.
If no arguments are given, returns all contacts for the customer.
+Arguments may contain classnums. When classnums are specified, only
+contacts with a matching cust_contact.classnum are returned. When a
+classnum of 0 is given, contacts with a null classnum are also included.
+
+Arguments may also contain the dest flag names 'invoice' or 'message'.
+If given, contacts who's invoice_dest and/or message_dest flags are
+not set to 'Y' will be excluded.
+
=cut
sub contact_list {
my $self = shift;
my $search = {
table => 'contact',
- select => 'contact.*, cust_contact.invoice_dest',
+ select => join(', ',(
+ 'contact.*',
+ 'cust_contact.invoice_dest',
+ 'cust_contact.message_dest',
+ )),
addl_from => ' JOIN cust_contact USING (contactnum)',
extra_sql => ' WHERE cust_contact.custnum = '.$self->custnum,
};
- my @orwhere;
+ # Bugfix notes:
+ # Calling methods were relying on this method to use invoice_dest to
+ # block e-mail messages. Depending on parameters, this may or may not
+ # have actually happened.
+ #
+ # The bug could cause this SQL to be used to filter e-mail addresses:
+ #
+ # AND (
+ # cust_contact.classnums IN (1,2,3)
+ # OR cust_contact.invoice_dest = 'Y'
+ # )
+ #
+ # improperly including everybody with the opt-in flag AND everybody
+ # in the contact classes
+ #
+ # Possibility to introduce new bugs:
+ # If callers of this method called it incorrectly, and didn't notice
+ # because it seemed to send the e-mails they wanted.
+
+ # WHERE ...
+ # AND (
+ # (
+ # cust_contact.classnum IN (1,2,3)
+ # OR
+ # cust_contact.classnum IS NULL
+ # )
+ # AND (
+ # cust_contact.invoice_dest = 'Y'
+ # OR
+ # cust_contact.message_dest = 'Y'
+ # )
+ # )
+
+ my @and_dest;
+ my @or_classnum;
my @classnums;
- foreach (@_) {
- if ( $_ eq 'invoice' ) {
- push @orwhere, 'cust_contact.invoice_dest = \'Y\'';
- } elsif ( $_ eq '0' ) {
- push @orwhere, 'cust_contact.classnum is null';
+ for (@_) {
+ if ($_ eq 'invoice' || $_ eq 'message') {
+ push @and_dest, " cust_contact.${_}_dest = 'Y' ";
+ } elsif ($_ eq '0') {
+ push @or_classnum, ' cust_contact.classnum IS NULL ';
} elsif ( /^\d+$/ ) {
push @classnums, $_;
} else {
- die "bad classnum argument '$_'";
+ croak "bad classnum argument '$_'";
}
}
- if (@classnums) {
- push @orwhere, 'cust_contact.classnum IN ('.join(',', @classnums).')';
- }
- if (@orwhere) {
- $search->{extra_sql} .= ' AND (' .
- join(' OR ', map "( $_ )", @orwhere) .
- ')';
+ push @or_classnum, 'cust_contact.classnum IN ('.join(',',@classnums).')'
+ if @classnums;
+
+ if (@or_classnum || @and_dest) { # catch, no arguments given
+ $search->{extra_sql} .= ' AND ( ';
+
+ if (@or_classnum) {
+ $search->{extra_sql} .= ' ( ';
+ $search->{extra_sql} .= join ' OR ', map {" $_ "} @or_classnum;
+ $search->{extra_sql} .= ' ) ';
+ $search->{extra_sql} .= ' AND ( ' if @and_dest;
+ }
+
+ if (@and_dest) {
+ $search->{extra_sql} .= join ' OR ', map {" $_ "} @and_dest;
+ $search->{extra_sql} .= ' ) ' if @or_classnum;
+ }
+
+ $search->{extra_sql} .= ' ) ';
+
+ warn "\$extra_sql: $search->{extra_sql} \n" if $DEBUG;
}
qsearch($search);
my $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;
);
}
+=item max_invnum
+
+Returns the most recent invnum (invoice number) for this customer.
+
+=cut
+
+sub max_invnum {
+ my $self = shift;
+ $self->scalar_sql(
+ " SELECT MAX(invnum) FROM cust_bill WHERE custnum = ?",
+ $self->custnum
+ );
+}
+
=item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
Returns all the invoices (see L<FS::cust_bill>) for this customer.
$name;
}
+=item batch_payment_payname
+
+Returns a name string for this customer, either "cust_batch_payment->payname" or "First Last" or "Company,
+based on if a company name exists and is the account being used a business account.
+
+=cut
+
+sub batch_payment_payname {
+ my $self = shift;
+ my $cust_pay_batch = shift;
+ my $name;
+
+ if ($cust_pay_batch->{Hash}->{payby} eq "CARD") { $name = $cust_pay_batch->payname; }
+ else { $name = $self->first .' '. $self->last; }
+
+ $name = $self->company
+ if (($cust_pay_batch->{Hash}->{paytype} eq "Business checking" || $cust_pay_batch->{Hash}->{paytype} eq "Business savings") && $self->company);
+
+ $name;
+}
+
=item service_contact
Returns the L<FS::contact> object for this customer that has the 'Service'
next if grep(/^$field$/, qw( custpaybynum payby weight ) );
next if grep(/^$field$/, @preserve );
next PAYBYLOOP unless $new->get($field) eq $cust_payby->get($field);
+ # check if paymask exists, if so stop and don't save, no need for a duplicate.
+ return '' if $new->get('paymask') eq $cust_payby->get('paymask');
}
# now check fields that can replace if one value is blank
my $replace = 0;
$param->{'fatal'} = 1; # runs from job queue, will be caught
$param->{'retry'} = 1;
- $cust_main->bill_and_collect( %$param );
+ local $@;
+ eval { $cust_main->bill_and_collect( %$param) };
+ if ( $@ ) {
+ die $@ =~ /cancel_pkgs cannot be run inside a transaction/
+ ? "Bill Now unavailable for customer with pending package expiration\n"
+ : $@;
+ }
+}
+
+=item pending_invoice_count
+
+Return number of cust_bill with pending=Y for this customer
+
+=cut
+
+sub pending_invoice_count {
+ FS::cust_bill->count( 'custnum = '.shift->custnum."AND pending = 'Y'" );
}
#starting to take quite a while for big dbs
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
+ # prior to 2013 (commit f16665c9) payinfo was stored in history if not
+ # encrypted, clear that out before encrypting/tokenizing anything else
if (!FS::upgrade_journal->is_done('clear_payinfo_history')) {
- foreach my $table ('cust_payby','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
- my $sql = 'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL';
+ foreach my $table (qw(
+ cust_payby cust_pay_pending cust_pay cust_pay_void cust_refund
+ )) {
+ my $sql =
+ 'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL';
my $sth = dbh->prepare($sql) or die dbh->errstr;
$sth->execute or die $sth->errstr;
}
FS::upgrade_journal->set_done('clear_payinfo_history');
}
- # encrypt old records
- if ($conf->exists('encryption') && !FS::upgrade_journal->is_done('encryption_check')) {
+ # 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;
local $FS::UID::AutoCommit = 1;
# encrypt what's there
- foreach my $table ('cust_payby','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
+ 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)) {
+ while (
+ my $recnum = _upgrade_next_recnum(dbh,$table,\$lastrecnum,\@recnums)
+ ) {
my $record = $tclass->by_key($recnum);
next unless $record; # small chance it's been deleted, that's ok
next unless grep { $record->payby eq $_ } @FS::Record::encrypt_payby;
# window for possible conflict is practically nonexistant,
# but just in case...
$record = $record->select_for_update;
+ if (!$record->custnum && $table eq 'cust_pay_pending') {
+ $record->set('custnum_pending',1);
+ }
+ $record->paycardtype('') if $record->paycardtype eq 'Tokenized';
+
+ local($ignore_expired_card) = 1;
+ local($ignore_banned_card) = 1;
+ local($skip_fuzzyfiles) = 1;
+ local($import) = 1;#prevent automatic geocoding (need its own variable?)
+
my $error = $record->replace;
- die $error if $error;
+ die "Error replacing $table ".$record->get($record->primary_key).": $error" if $error;
}
}
- FS::upgrade_journal->set_done('encryption_check');
+ FS::upgrade_journal->set_done('paycardtype_Tokenized');
+ FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption');
}
# now that everything's encrypted, tokenize...
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.
- ' ORDER BY '.$tclass->primary_key.' LIMIT 500';;
+ " 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;
=cut
1;
-