package FS::cust_main;
use strict;
-use vars qw( @ISA $conf $Debug $import );
-use vars qw( $realtime_bop_decline_quiet ); #ugh
+use vars qw( @ISA $conf $DEBUG $import );
use Safe;
use Carp;
BEGIN {
use Business::CreditCard;
use FS::UID qw( getotaker dbh );
use FS::Record qw( qsearchs qsearch dbdef );
-use FS::Misc qw( send_email );
use FS::cust_pkg;
use FS::cust_bill;
use FS::cust_bill_pkg;
@ISA = qw( FS::Record );
-$realtime_bop_decline_quiet = 0;
-
-$Debug = 0;
-#$Debug = 1;
+$DEBUG = 0;
+#$DEBUG = 1;
$import = 0;
#ask FS::UID to run this stuff for us later
-#$FS::UID::callback{'FS::cust_main'} = sub {
-install_callback FS::UID sub {
+$FS::UID::callback{'FS::cust_main'} = sub {
$conf = new FS::Conf;
#yes, need it for stuff below (prolly should be cached)
};
=item ship_fax - phone (optional)
-=item payby - I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>)
+=item payby - `CARD' (credit cards), `CHEK' (electronic check), `LECB' (Phone bill billing), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
=item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
-=item paycvv - Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
-
=item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
=item payname - name on card or billing name
=item comments - comments (optional)
-=item referral_custnum - referring customer number
-
=back
=head1 METHODS
$cust_main->insert( {}, [ $email, 'POST' ] );
-Currently available options are: I<noexport>
+Currently available options are: I<depend_jobnum> and I<noexport>.
-If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
-(You can schedule them later with the B<reexport> method.)
+If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
+on the supplied jobnum (they will not run until the specific job completes).
+This can be used to defer provisioning until some action completes (such
+as running the customer's credit card sucessfully).
+
+The I<noexport> option is deprecated. If I<noexport> is set true, no
+provisioning jobs (exports) are scheduled. (You can schedule them later with
+the B<reexport> method.)
=cut
my $cust_pkgs = @_ ? shift : {};
my $invoicing_list = @_ ? shift : '';
my %options = @_;
+ warn "FS::cust_main::insert called with options ".
+ join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
+ if $DEBUG;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
}
# packages
- #local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
$error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
}
-=item order_pkgs HASHREF, [ , OPTION => VALUE ... ] ]
+=item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
Like the insert method on an existing record, this method orders a package
and included services atomicaly. Pass a Tie::RefHash data structure to this
$cust_pkg => [ $svc_acct ],
...
);
- $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
+ $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
+
+Currently available options are: I<depend_jobnum> and I<noexport>.
-Currently available options are: I<noexport>
+If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
+on the supplied jobnum (they will not run until the specific job completes).
+This can be used to defer provisioning until some action completes (such
+as running the customer's credit card sucessfully).
-If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
-(You can schedule them later with the B<reexport> method for each
-cust_pkg object. Using the B<reexport> method on the cust_main object is not
-recommended, as existing services will also be reexported.)
+The I<noexport> option is deprecated. If I<noexport> is set true, no
+provisioning jobs (exports) are scheduled. (You can schedule them later with
+the B<reexport> method for each cust_pkg object. Using the B<reexport> method
+on the cust_main object is not recommended, as existing services will also be
+reexported.)
=cut
my $cust_pkgs = shift;
my $seconds = shift;
my %options = @_;
+ my %svc_options = ();
+ $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
+ if exists $options{'depend_jobnum'};
+ warn "FS::cust_main::order_pkgs called with options ".
+ join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
+ if $DEBUG;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
$svc_something->seconds( $svc_something->seconds + $$seconds );
$$seconds = 0;
}
- $error = $svc_something->insert;
+ $error = $svc_something->insert(%svc_options);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
#return "inserting svc_ (transaction rolled back): $error";
=item reexport
+This method is deprecated. See the I<depend_jobnum> option to the insert and
+order_pkgs methods for a better way to defer provisioning.
+
Re-schedules all exports by calling the B<reexport> method of all associated
packages (see L<FS::cust_pkg>). If there is an error, returns the error;
otherwise returns false.
sub reexport {
my $self = shift;
+ carp "warning: FS::cust_main::reexport is deprectated; ".
+ "use the depend_jobnum option to insert or order_pkgs to delay export";
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
}
}
- $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
+ $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREPAY)$/
or return "Illegal payby: ". $self->payby;
$self->payby($1);
- if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
+ if ( $self->payby eq 'CARD' ) {
my $payinfo = $self->payinfo;
$payinfo =~ s/\D//g;
}
}
- } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
+ } elsif ( $self->payby eq 'CHEK' ) {
my $payinfo = $self->payinfo;
$payinfo =~ s/[^\d\@]//g;
unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
$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 =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
- ( $m, $y ) = ( $3, "20$2" );
- } else {
- return "Illegal expiration date: ". $self->paydate;
- }
- $self->paydate("$y-$m-01");
+ $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
+ or return "Illegal expiration date: ". $self->paydate;
+ my $y = length($2) == 4 ? $2 : "20$2";
+ $self->paydate("$y-$1-01");
my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
return gettext('expired_card')
if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
}
if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
- ( ! $conf->exists('require_cardname')
- || $self->payby !~ /^(CARD|DCRD)$/ )
- ) {
+ ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
$self->payname( $self->first. " ". $self->getfield('last') );
} else {
$self->payname =~ /^([\w \,\.\-\']+)$/
#warn "AFTER: \n". $self->_dump;
- $self->SUPER::check;
+ ''; #no error
}
=item all_pkgs
grep { $_->suspend } $self->unsuspended_pkgs;
}
+=item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
+
+Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
+PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list on
+success or a list of errors.
+
+=cut
+
+sub suspend_if_pkgpart {
+ my $self = shift;
+ my @pkgparts = @_;
+ grep { $_->suspend }
+ grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
+ $self->unsuspended_pkgs;
+}
+
+=item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
+
+Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
+listed PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list
+on success or a list of errors.
+
+=cut
+
+sub suspend_unless_pkgpart {
+ my $self = shift;
+ my @pkgparts = @_;
+ grep { $_->suspend }
+ grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
+ $self->unsuspended_pkgs;
+}
+
=item cancel [ OPTION => VALUE ... ]
Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
sub cancel {
my $self = shift;
- grep { $_->cancel(@_) } $self->ncancelled_pkgs;
+ grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
}
=item agent
sub bill {
my( $self, %options ) = @_;
+ return '' if $self->payby eq 'COMP';
my $time = $options{'time'} || time;
my $error;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
+ $self->select_for_update; #mutex
+
# find the packages which are due for billing, find out how much they are
# & generate invoice database.
my %hash = $cust_pkg->hash;
my $old_cust_pkg = new FS::cust_pkg \%hash;
- my @details = ();
-
# bill setup
my $setup = 0;
if ( !$cust_pkg->setup || $options{'resetup'} ) {
}
$setup = sprintf( "%.2f", $setup );
$recur = sprintf( "%.2f", $recur );
- if ( $setup < 0 ) {
+ if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
$dbh->rollback if $oldAutoCommit;
return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
}
- if ( $recur < 0 ) {
+ if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
$dbh->rollback if $oldAutoCommit;
return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
}
- if ( $setup > 0 || $recur > 0 ) {
+ if ( $setup != 0 || $recur != 0 ) {
my $cust_bill_pkg = new FS::cust_bill_pkg ({
- 'pkgnum' => $cust_pkg->pkgnum,
- 'setup' => $setup,
- 'recur' => $recur,
- 'sdate' => $sdate,
- 'edate' => $cust_pkg->bill,
- 'details' => \@details,
+ 'pkgnum' => $cust_pkg->pkgnum,
+ 'setup' => $setup,
+ 'recur' => $recur,
+ 'sdate' => $sdate,
+ 'edate' => $cust_pkg->bill,
});
push @cust_bill_pkg, $cust_bill_pkg;
$total_setup += $setup;
join('/', ( map $self->$_(), qw(state county country) ),
$part_pkg->taxclass ). "\n";
}
-
+
foreach my $tax ( @taxes ) {
my $taxable_charged = 0;
} #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
- } #if $setup > 0 || $recur > 0
+ } #if $setup != 0 || $recur != 0
} #if $cust_pkg_mod_flag
(Attempt to) collect money for this customer's outstanding invoices (see
L<FS::cust_bill>). Usually used after the bill method.
-Depending on the value of `payby', this may print or email an invoice (I<BILL>,
-I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
-check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
+Depending on the value of `payby', this may print an invoice (`BILL'), charge
+a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
Most actions are now triggered by invoice events; see L<FS::part_bill_event>
and the invoice events web interface.
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
+ $self->select_for_update; #mutex
+
my $balance = $self->balance;
- warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
+ warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG;
unless ( $balance > 0 ) { #redundant?????
$dbh->rollback if $oldAutoCommit; #hmm
return '';
last if $self->balance <= 0;
warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
- if $Debug;
+ if $DEBUG;
foreach my $part_bill_event (
sort { $a->seconds <=> $b->seconds
|| $a->weight <=> $b->weight
|| $a->eventpart <=> $b->eventpart }
grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
- && ! qsearchs( 'cust_bill_event', {
+ && ! qsearch( 'cust_bill_event', {
'invnum' => $cust_bill->invnum,
'eventpart' => $_->eventpart,
'status' => 'done',
|| $self->balance <= 0; # or if balance<=0
warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
- if $Debug;
+ if $DEBUG;
my $cust_main = $self; #for callback
my $error;
{
- local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
+ #supress "used only once" warning
+ $FS::cust_bill::realtime_bop_decline_quiet += 0;
+ local $FS::cust_bill::realtime_bop_decline_quiet = 1
+ if $options{'quiet'};
$error = eval $part_bill_event->eventcode;
}
}
-=item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
-
-Runs a realtime credit card, ACH (electronic check) or phone bill transaction
-via a Business::OnlinePayment realtime gateway. See
-L<http://420.am/business-onlinepayment> for supported gateways.
-
-Available methods are: I<CC>, I<ECHECK> and I<LEC>
-
-Available options are: I<description>, I<invnum>, I<quiet>
-
-The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
-I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
-if set, will override the value from the customer record.
-
-I<description> is a free-text field passed to the gateway. It defaults to
-"Internet services".
-
-If an I<invnum> is specified, this payment (if sucessful) is applied to the
-specified invoice. If you don't specify an I<invnum> you might want to
-call the B<apply_payments> method.
-
-I<quiet> can be set true to surpress email decline notices.
-
-(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
-
-=cut
-
-sub realtime_bop {
- my( $self, $method, $amount, %options ) = @_;
- if ( $Debug ) {
- warn "$self $method $amount\n";
- warn " $_ => $options{$_}\n" foreach keys %options;
- }
-
- $options{'description'} ||= 'Internet services';
-
- #pre-requisites
- die "Real-time processing not enabled\n"
- unless $conf->exists('business-onlinepayment');
- eval "use Business::OnlinePayment";
- die $@ if $@;
-
- #overrides
- $self->set( $_ => $options{$_} )
- foreach grep { exists($options{$_}) }
- qw( payname address1 address2 city state zip payinfo paydate );
-
- #load up config
- my $bop_config = 'business-onlinepayment';
- $bop_config .= '-ach'
- if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
- my ( $processor, $login, $password, $action, @bop_options ) =
- $conf->config($bop_config);
- $action ||= 'normal authorization';
- pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
-
- #massage data
-
- my $address = $self->address1;
- $address .= ", ". $self->address2 if $self->address2;
-
- my($payname, $payfirst, $paylast);
- if ( $self->payname && $method ne 'ECHECK' ) {
- $payname = $self->payname;
- $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
- or return "Illegal payname $payname";
- ($payfirst, $paylast) = ($1, $2);
- } else {
- $payfirst = $self->getfield('first');
- $paylast = $self->getfield('last');
- $payname = "$payfirst $paylast";
- }
-
- my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
- if ( $conf->exists('emailinvoiceauto')
- || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
- push @invoicing_list, $self->all_emails;
- }
- my $email = $invoicing_list[0];
-
- my %content;
- if ( $method eq 'CC' ) {
-
- $content{card_number} = $self->payinfo;
- $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
- $content{expiration} = "$2/$1";
-
- $content{cvv2} = $self->paycvv
- if defined $self->dbdef_table->column('paycvv')
- && length($self->paycvv);
-
- $content{recurring_billing} = 'YES'
- if qsearch('cust_pay', { 'custnum' => $self->custnum,
- 'payby' => 'CARD',
- 'payinfo' => $self->payinfo, } );
-
- } elsif ( $method eq 'ECHECK' ) {
- my($account_number,$routing_code) = $self->payinfo;
- ( $content{account_number}, $content{routing_code} ) =
- split('@', $self->payinfo);
- $content{bank_name} = $self->payname;
- $content{account_type} = 'CHECKING';
- $content{account_name} = $payname;
- $content{customer_org} = $self->company ? 'B' : 'I';
- $content{customer_ssn} = $self->ss;
- } elsif ( $method eq 'LEC' ) {
- $content{phone} = $self->payinfo;
- }
-
- #transaction(s)
-
- my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
-
- my $transaction =
- new Business::OnlinePayment( $processor, @bop_options );
- $transaction->content(
- 'type' => $method,
- 'login' => $login,
- 'password' => $password,
- 'action' => $action1,
- 'description' => $options{'description'},
- 'amount' => $amount,
- 'invoice_number' => $options{'invnum'},
- 'customer_id' => $self->custnum,
- 'last_name' => $paylast,
- 'first_name' => $payfirst,
- 'name' => $payname,
- 'address' => $address,
- 'city' => $self->city,
- 'state' => $self->state,
- 'zip' => $self->zip,
- 'country' => $self->country,
- 'referer' => 'http://cleanwhisker.420.am/',
- 'email' => $email,
- 'phone' => $self->daytime || $self->night,
- %content, #after
- );
- $transaction->submit();
-
- if ( $transaction->is_success() && $action2 ) {
- my $auth = $transaction->authorization;
- my $ordernum = $transaction->can('order_number')
- ? $transaction->order_number
- : '';
-
- my $capture =
- new Business::OnlinePayment( $processor, @bop_options );
-
- my %capture = (
- %content,
- type => $method,
- action => $action2,
- login => $login,
- password => $password,
- order_number => $ordernum,
- amount => $amount,
- authorization => $auth,
- description => $options{'description'},
- );
-
- foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
- transaction_sequence_num local_transaction_date
- local_transaction_time AVS_result_code )) {
- $capture{$field} = $transaction->$field() if $transaction->can($field);
- }
-
- $capture->content( %capture );
-
- $capture->submit();
-
- unless ( $capture->is_success ) {
- my $e = "Authorization sucessful but capture failed, custnum #".
- $self->custnum. ': '. $capture->result_code.
- ": ". $capture->error_message;
- warn $e;
- return $e;
- }
-
- }
-
- #remove paycvv after initial transaction
- #make this disable-able via a config option if anyone insists?
- # (though that probably violates cardholder agreements)
- if ( defined $self->dbdef_table->column('paycvv')
- && length($self->paycvv)
- && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
- ) {
- my $new = new FS::cust_main { $self->hash };
- $new->paycvv('');
- my $error = $new->replace($self);
- if ( $error ) {
- warn "error removing cvv: $error\n";
- }
- }
-
- #result handling
- if ( $transaction->is_success() ) {
-
- my %method2payby = (
- 'CC' => 'CARD',
- 'ECHECK' => 'CHEK',
- 'LEC' => 'LECB',
- );
-
- my $cust_pay = new FS::cust_pay ( {
- 'custnum' => $self->custnum,
- 'invnum' => $options{'invnum'},
- 'paid' => $amount,
- '_date' => '',
- 'payby' => $method2payby{$method},
- 'payinfo' => $self->payinfo,
- 'paybatch' => "$processor:". $transaction->authorization,
- } );
- my $error = $cust_pay->insert;
- if ( $error ) {
- # gah, even with transactions.
- my $e = 'WARNING: Card/ACH debited but database not updated - '.
- 'error applying payment, invnum #' . $self->invnum.
- " ($processor): $error";
- warn $e;
- return $e;
- } else {
- return '';
- }
-
- } else {
-
- my $perror = "$processor error: ". $transaction->error_message;
-
- if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
- && $conf->exists('emaildecline')
- && grep { $_ ne 'POST' } $self->invoicing_list
- && ! grep { $_ eq $transaction->error_message }
- $conf->config('emaildecline-exclude')
- ) {
- my @templ = $conf->config('declinetemplate');
- my $template = new Text::Template (
- TYPE => 'ARRAY',
- SOURCE => [ map "$_\n", @templ ],
- ) or return "($perror) can't create template: $Text::Template::ERROR";
- $template->compile()
- or return "($perror) can't compile template: $Text::Template::ERROR";
-
- my $templ_hash = { error => $transaction->error_message };
-
- my $error = send_email(
- 'from' => $conf->config('invoice_from'),
- 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
- 'subject' => 'Your payment could not be processed',
- 'body' => [ $template->fill_in(HASH => $templ_hash) ],
- );
-
- $perror .= " (also received error sending decline notification: $error)"
- if $error;
-
- }
-
- return $perror;
- }
-
-}
-
=item total_owed
Returns the total owed for this customer on all invoices
qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
}
+=item select_for_update
+
+Selects this record with the SQL "FOR UPDATE" command. This can be useful as
+a mutex.
+
+=cut
+
+sub select_for_update {
+ my $self = shift;
+ qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
+}
+
=back
=head1 SUBROUTINES
my %cust_main = (
agentnum => $agentnum,
refnum => $refnum,
- country => 'US', #default
+ country => $conf->config('countrydefault') || 'US',
payby => 'BILL', #default
paydate => '12/2037', #default
);