use strict;
use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
- $import $skip_fuzzyfiles $ignore_expired_card );
+ $import $skip_fuzzyfiles $ignore_expired_card @paytypes);
use vars qw( $realtime_bop_decline_quiet ); #ugh
use Safe;
use Carp;
use String::Approx qw(amatch);
use Business::CreditCard 0.28;
use Locale::Country;
-use FS::UID qw( getotaker dbh );
+use Data::Dumper;
+use FS::UID qw( getotaker dbh driver_name );
use FS::Record qw( qsearchs qsearch dbdef );
-use FS::Misc qw( send_email );
+use FS::Misc qw( send_email generate_ps do_print );
use FS::Msgcat qw(gettext);
use FS::cust_pkg;
use FS::cust_svc;
use FS::cust_bill;
use FS::cust_bill_pkg;
use FS::cust_pay;
+use FS::cust_pay_pending;
use FS::cust_pay_void;
use FS::cust_credit;
use FS::cust_refund;
$ignore_expired_card = 0;
@encrypted_fields = ('payinfo', 'paycvv');
+@paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
#ask FS::UID to run this stuff for us later
#$FS::UID::callback{'FS::cust_main'} = sub {
$error = $self->check_invoicing_list( $invoicing_list );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "checking invoicing_list (transaction rolled back): $error";
+ #return "checking invoicing_list (transaction rolled back): $error";
+ return $error;
}
$self->invoicing_list( $invoicing_list );
}
|| $self->ut_country('country')
|| $self->ut_anything('comments')
|| $self->ut_numbern('referral_custnum')
+ || $self->ut_textn('stateid')
+ || $self->ut_textn('stateid_state')
;
#barf. need message catalogs. i18n. etc.
$error .= "Please select an advertising source."
;
return $error if $error;
+ if ( $conf->exists('cust_main-require_phone')
+ && ! length($self->daytime) && ! length($self->night)
+ ) {
+
+ my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
+ ? 'Day Phone'
+ : FS::Msgcat::_gettext('daytime');
+ my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
+ ? 'Night Phone'
+ : FS::Msgcat::_gettext('night');
+
+ return "$daytime_label or $night_label is required"
+
+ }
+
my @addfields = qw(
last first company address1 address2 city county state zip
country daytime night fax
$error = $self->ut_numbern('paystart_month')
|| $self->ut_numbern('paystart_year')
|| $self->ut_numbern('payissue')
+ || $self->ut_textn('paytype')
;
return $error if $error;
}
sub num_pkgs {
- my( $self, $sql ) = @_;
+ my( $self ) = shift;
+ my $sql = scalar(@_) ? shift : '';
$sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
my $sth = dbh->prepare(
"SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
conjunction with the collect method.
-Options are passed as name-value pairs.
+If there is an error, returns the error, otherwise returns false.
-Currently available options are:
+Options are passed as name-value pairs. Currently available options are:
+
+=over 4
-resetup - if set true, re-charges setup fees.
+=item resetup - if set true, re-charges setup fees.
-time - bills the customer as if it were that time. Specified as a UNIX
-timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
-L<Date::Parse> for conversion functions. For example:
+=item time - bills the customer as if it were that time. Specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. For example:
use Date::Parse;
...
$cust_main->bill( 'time' => str2time('April 20th, 2001') );
+=item invoice_time - used in conjunction with the I<time> option, this option specifies the date of for the generated invoices. Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
-If there is an error, returns the error, otherwise returns false.
+=back
=cut
# no line items] and we're inside a transaciton so nothing else will see it)
my $cust_bill = new FS::cust_bill ( {
'custnum' => $self->custnum,
- '_date' => $time,
+ '_date' => ( $options{'invoice_time'} || $time ),
#'charged' => $charged,
'charged' => 0,
} );
###
my $setup = 0;
- if ( !$cust_pkg->setup || $options{'resetup'} ) {
+ if ( ! $cust_pkg->setup &&
+ (
+ ( $conf->exists('disable_setup_suspended_pkgs') &&
+ ! $cust_pkg->getfield('susp')
+ ) || ! $conf->exists('disable_setup_suspended_pkgs')
+ )
+ || $options{'resetup'}
+ ) {
warn " bill setup\n" if $DEBUG > 1;
Available methods are: I<CC>, I<ECHECK> and I<LEC>
-Available options are: I<description>, I<invnum>, I<quiet>
+Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
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,
I<quiet> can be set true to surpress email decline notices.
+I<paynum_ref> can be set to a scalar reference. It will be filled in with the
+resulting paynum, if any.
+
+I<payunique> is a unique identifier for this payment.
+
(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
+=back
+
=cut
sub realtime_bop {
? $options{'payinfo'}
: $self->payinfo;
+ my %method2payby = (
+ 'CC' => 'CARD',
+ 'ECHECK' => 'CHEK',
+ 'LEC' => 'LECB',
+ );
+
###
# select a gateway
###
$payname = "$payfirst $paylast";
}
- my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
- if ( $conf->exists('emailinvoiceauto')
+ my @invoicing_list = $self->invoicing_list_emailonly;
+ if ( $conf->exists('emailinvoiceautoalways')
+ || $conf->exists('emailinvoiceauto') && ! @invoicing_list
|| ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
push @invoicing_list, $self->all_emails;
}
$content{invoice_number} = $options{'invnum'}
if exists($options{'invnum'}) && length($options{'invnum'});
+ $content{email_customer} =
+ ( $conf->exists('business-onlinepayment-email_customer')
+ || $conf->exists('business-onlinepayment-email-override') );
+
+ my $paydate = '';
if ( $method eq 'CC' ) {
$content{card_number} = $payinfo;
- my $paydate = exists($options{'paydate'})
+ $paydate = exists($options{'paydate'})
? $options{'paydate'}
: $self->paydate;
$paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
my $paycvv = exists($options{'paycvv'})
? $options{'paycvv'}
: $self->paycvv;
- $content{cvv2} = $self->paycvv
+ $content{cvv2} = $paycvv
if length($paycvv);
my $paystart_month = exists($options{'paystart_month'})
( $content{account_number}, $content{routing_code} ) =
split('@', $payinfo);
$content{bank_name} = $o_payname;
- $content{account_type} = 'CHECKING';
+ $content{bank_state} = exists($options{'paystate'})
+ ? $options{'paystate'}
+ : $self->getfield('paystate');
+ $content{account_type} = exists($options{'paytype'})
+ ? uc($options{'paytype'}) || 'CHECKING'
+ : uc($self->getfield('paytype')) || 'CHECKING';
$content{account_name} = $payname;
$content{customer_org} = $self->company ? 'B' : 'I';
+ $content{state_id} = exists($options{'stateid'})
+ ? $options{'stateid'}
+ : $self->getfield('stateid');
+ $content{state_id_state} = exists($options{'stateid_state'})
+ ? $options{'stateid_state'}
+ : $self->getfield('stateid_state');
$content{customer_ssn} = exists($options{'ss'})
? $options{'ss'}
: $self->ss;
# run transaction(s)
###
+ my $balance = exists( $options{'balance'} )
+ ? $options{'balance'}
+ : $self->balance;
+
+ $self->select_for_update; #mutex ... just until we get our pending record in
+
+ #the checks here are intended to catch concurrent payments
+ #double-form-submission prevention is taken care of in cust_pay_pending::check
+
+ #check the balance
+ return "The customer's balance has changed; $method transaction aborted."
+ if $self->balance < $balance;
+ #&& $self->balance < $amount; #might as well anyway?
+
+ #also check and make sure there aren't *other* pending payments for this cust
+
+ my @pending = qsearch('cust_pay_pending', {
+ 'custnum' => $self->custnum,
+ 'status' => { op=>'!=', value=>'done' }
+ });
+ return "A payment is already being processed for this customer (".
+ join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
+ "); $method transaction aborted."
+ if scalar(@pending);
+
+ #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
+
+ my $cust_pay_pending = new FS::cust_pay_pending {
+ 'custnum' => $self->custnum,
+ #'invnum' => $options{'invnum'},
+ 'paid' => $amount,
+ '_date' => '',
+ 'payby' => $method2payby{$method},
+ 'payinfo' => $payinfo,
+ 'paydate' => $paydate,
+ 'status' => 'new',
+ 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
+ };
+ $cust_pay_pending->payunique( $options{payunique} )
+ if length($options{payunique});
+ my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
+ return $cpp_new_err if $cpp_new_err;
+
my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
my $transaction = new Business::OnlinePayment( $processor, @bop_options );
'phone' => $self->daytime || $self->night,
%content, #after
);
+
+ $cust_pay_pending->status('pending');
+ my $cpp_pending_err = $cust_pay_pending->replace;
+ return $cpp_pending_err if $cpp_pending_err;
+
$transaction->submit();
if ( $transaction->is_success() && $action2 ) {
+
+ $cust_pay_pending->status('authorized');
+ my $cpp_authorized_err = $cust_pay_pending->replace;
+ return $cpp_authorized_err if $cpp_authorized_err;
+
my $auth = $transaction->authorization;
my $ordernum = $transaction->can('order_number')
? $transaction->order_number
}
+ $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
+ my $cpp_captured_err = $cust_pay_pending->replace;
+ return $cpp_captured_err if $cpp_captured_err;
+
###
# remove paycvv after initial transaction
###
if ( $transaction->is_success() ) {
- my %method2payby = (
- 'CC' => 'CARD',
- 'ECHECK' => 'CHEK',
- 'LEC' => 'LECB',
- );
-
my $paybatch = '';
if ( $payment_gateway ) { # agent override
$paybatch = $payment_gateway->gatewaynum. '-';
'payby' => $method2payby{$method},
'payinfo' => $payinfo,
'paybatch' => $paybatch,
+ 'paydate' => $paydate,
} );
- my $error = $cust_pay->insert;
+ #doesn't hurt to know, even though the dup check is in cust_pay_pending now
+ $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
+
+ my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
+
if ( $error ) {
$cust_pay->invnum(''); #try again with no specific invnum
- my $error2 = $cust_pay->insert;
+ my $error2 = $cust_pay->insert( $options{'manual'} ?
+ ( 'manual' => 1 ) : ()
+ );
if ( $error2 ) {
- # gah, even with transactions.
- my $e = 'WARNING: Card/ACH debited but database not updated - '.
+ # gah. but at least we have a record of the state we had to abort in
+ # from cust_pay_pending now.
+ my $e = "WARNING: $method captured but payment not recorded - ".
"error inserting payment ($processor): $error2".
" (previously tried insert with invnum #$options{'invnum'}" .
- ": $error )";
+ ": $error ) - pending payment saved as paypendingnum ".
+ $cust_pay_pending->paypendingnum. "\n";
warn $e;
return $e;
}
}
- return ''; #no error
+
+ if ( $options{'paynum_ref'} ) {
+ ${ $options{'paynum_ref'} } = $cust_pay->paynum;
+ }
+
+ $cust_pay_pending->status('done');
+ $cust_pay_pending->statustext('captured');
+ my $cpp_done_err = $cust_pay_pending->replace;
+
+ if ( $cpp_done_err ) {
+
+ $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+ my $e = "WARNING: $method captured but payment not recorded - ".
+ "error updating status for paypendingnum ".
+ $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
+ warn $e;
+ return $e;
+
+ } else {
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return ''; #no error
+
+ }
} else {
my $perror = "$processor error: ". $transaction->error_message;
+ unless ( $transaction->error_message ) {
+
+ my $t_response;
+ #this should be normalized :/
+ #
+ # bad, ad-hoc B:OP:PayflowPro "transaction_response" BS
+ if ( $transaction->can('param')
+ && $transaction->param('transaction_response') ) {
+ $t_response = $transaction->param('transaction_response')
+
+ # slightly better, ad-hoc B:OP:TransactionCentral without "param"
+ } elsif ( $transaction->can('response_page') ) {
+ $t_response = {
+ 'page' => ( $transaction->can('response_page')
+ ? $transaction->response_page
+ : ''
+ ),
+ 'code' => ( $transaction->can('response_code')
+ ? $transaction->response_code
+ : ''
+ ),
+ 'headers' => ( $transaction->can('response_headers')
+ ? $transaction->response_headers
+ : ''
+ ),
+ };
+ } else {
+ $t_response .=
+ "No additional debugging information available for $processor";
+ }
+
+ $perror .= "No error_message returned from $processor -- ".
+ ( ref($t_response) ? Dumper($t_response) : $t_response );
+
+ }
+
if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
&& $conf->exists('emaildecline')
&& grep { $_ ne 'POST' } $self->invoicing_list
if $error;
}
-
+
+ $cust_pay_pending->status('done');
+ $cust_pay_pending->statustext("declined: $perror");
+ my $cpp_done_err = $cust_pay_pending->replace;
+ if ( $cpp_done_err ) {
+ my $e = "WARNING: $method declined but pending payment not resolved - ".
+ "error updating status for paypendingnum ".
+ $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
+ warn $e;
+ $perror = "$e ($perror)";
+ }
+
return $perror;
}
#load up config
my $bop_config = 'business-onlinepayment';
$bop_config .= '-ach'
- if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
+ if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
my ( $processor, $login, $password, $action, @bop_options ) =
$conf->config($bop_config);
$action ||= 'normal authorization';
Available methods are: I<CC>, I<ECHECK> and I<LEC>
-Available options are: I<amount>, I<reason>, I<paynum>
+Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
Most gateways require a reference to an original payment transaction to refund,
so you probably need to specify a I<paynum>.
I<reason> specifies a reason for the refund.
+I<paydate> specifies the expiration date for a credit card overriding the
+value from the customer record or the payment record. Specified as yyyy-mm-dd
+
Implementation note: If I<amount> is unspecified or equal to the amount of the
orignal payment, first an attempt is made to "void" the transaction via
the gateway (to cancel a not-yet settled transaction) and then if that fails,
or return "Unknown paynum $options{'paynum'}";
$amount ||= $cust_pay->paid;
- $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
+ $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
or return "Can't parse paybatch for paynum $options{'paynum'}: ".
$cust_pay->paybatch;
my $gatewaynum = '';
if length($auth); #echeck/ACH transactions have an order # but no auth
#(at least with authorize.net)
+ my $disable_void_after;
+ if ($conf->exists('disable_void_after')
+ && $conf->config('disable_void_after') =~ /^(\d+)$/) {
+ $disable_void_after = $1;
+ }
+
#first try void if applicable
- if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
+ if ( $cust_pay && $cust_pay->paid == $amount
+ && (
+ ( not defined($disable_void_after) )
+ || ( time < ($cust_pay->_date + $disable_void_after ) )
+ )
+ ) {
warn " attempting void\n" if $DEBUG > 1;
my $void = new Business::OnlinePayment( $processor, @bop_options );
$void->content( 'action' => 'void', %content );
$payname = "$payfirst $paylast";
}
- my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
- if ( $conf->exists('emailinvoiceauto')
+ my @invoicing_list = $self->invoicing_list_emailonly;
+ if ( $conf->exists('emailinvoiceautoalways')
+ || $conf->exists('emailinvoiceauto') && ! @invoicing_list
|| ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
push @invoicing_list, $self->all_emails;
}
if ( $cust_pay ) {
$content{card_number} = $payinfo = $cust_pay->payinfo;
- #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
- #$content{expiration} = "$2/$1";
+ (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
+ =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
+ ($content{expiration} = "$2/$1"); # where available
} else {
$content{card_number} = $payinfo = $self->payinfo;
- $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
+ (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
+ =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
$content{expiration} = "$2/$1";
}
} elsif ( $method eq 'ECHECK' ) {
- ( $content{account_number}, $content{routing_code} ) =
- split('@', $payinfo = $self->payinfo);
+
+ if ( $cust_pay ) {
+ $payinfo = $cust_pay->payinfo;
+ } else {
+ $payinfo = $self->payinfo;
+ }
+ ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
$content{bank_name} = $self->payname;
$content{account_type} = 'CHECKING';
$content{account_name} = $payname;
}
+=item batch_card OPTION => VALUE...
+
+Adds a payment for this invoice to the pending credit card batch (see
+L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
+runs the payment using a realtime gateway.
+
+=cut
+
+sub batch_card {
+ my ($self, %options) = @_;
+
+ my $amount;
+ if (exists($options{amount})) {
+ $amount = $options{amount};
+ }else{
+ $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
+ }
+ return '' unless $amount > 0;
+
+ my $invnum = delete $options{invnum};
+ my $payby = $options{invnum} || $self->payby; #dubious
+
+ if ($options{'realtime'}) {
+ return $self->realtime_bop( FS::payby->payby2bop($self->payby),
+ $amount,
+ %options,
+ );
+ }
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ #this needs to handle mysql as well as Pg, like svc_acct.pm
+ #(make it into a common function if folks need to do batching with mysql)
+ $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
+ or return "Cannot lock pay_batch: " . $dbh->errstr;
+
+ my %pay_batch = (
+ 'status' => 'O',
+ 'payby' => FS::payby->payby2payment($payby),
+ );
+
+ my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
+
+ unless ( $pay_batch ) {
+ $pay_batch = new FS::pay_batch \%pay_batch;
+ my $error = $pay_batch->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ die "error creating new batch: $error\n";
+ }
+ }
+
+ my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
+ 'batchnum' => $pay_batch->batchnum,
+ 'custnum' => $self->custnum,
+ } );
+
+ foreach (qw( address1 address2 city state zip country payby payinfo paydate
+ payname )) {
+ $options{$_} = '' unless exists($options{$_});
+ }
+
+ my $cust_pay_batch = new FS::cust_pay_batch ( {
+ 'batchnum' => $pay_batch->batchnum,
+ 'invnum' => $invnum || 0, # is there a better value?
+ # this field should be
+ # removed...
+ # cust_bill_pay_batch now
+ 'custnum' => $self->custnum,
+ 'last' => $self->getfield('last'),
+ 'first' => $self->getfield('first'),
+ 'address1' => $options{address1} || $self->address1,
+ 'address2' => $options{address2} || $self->address2,
+ 'city' => $options{city} || $self->city,
+ 'state' => $options{state} || $self->state,
+ 'zip' => $options{zip} || $self->zip,
+ 'country' => $options{country} || $self->country,
+ 'payby' => $options{payby} || $self->payby,
+ 'payinfo' => $options{payinfo} || $self->payinfo,
+ 'exp' => $options{paydate} || $self->paydate,
+ 'payname' => $options{payname} || $self->payname,
+ 'amount' => $amount, # consolidating
+ } );
+
+ $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
+ if $old_cust_pay_batch;
+
+ my $error;
+ if ($old_cust_pay_batch) {
+ $error = $cust_pay_batch->replace($old_cust_pay_batch)
+ } else {
+ $error = $cust_pay_batch->insert;
+ }
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ die $error;
+ }
+
+ my $unapplied = $self->total_credited + $self->total_unapplied_payments + $self->in_transit_payments;
+ foreach my $cust_bill ($self->open_cust_bill) {
+ #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
+ 'invnum' => $cust_bill->invnum,
+ 'paybatchnum' => $cust_pay_batch->paybatchnum,
+ 'amount' => $cust_bill->owed,
+ '_date' => time,
+ };
+ if ($unapplied >= $cust_bill_pay_batch->amount){
+ $unapplied -= $cust_bill_pay_batch->amount;
+ next;
+ }else{
+ $cust_bill_pay_batch->amount(sprintf ( "%.2f",
+ $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
+ }
+ $error = $cust_bill_pay_batch->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ die $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+}
+
=item total_owed
Returns the total owed for this customer on all invoices
In most cases, this new method should be used in place of sequential
apply_payments and apply_credits methods.
+If there is an error, returns the error, otherwise returns false.
+
=cut
sub apply_payments_and_credits {
my $self = shift;
+ 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;
+
+ $self->select_for_update; #mutex
+
foreach my $cust_bill ( $self->open_cust_bill ) {
- $cust_bill->apply_payments_and_credits;
+ my $error = $cust_bill->apply_payments_and_credits;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error applying: $error";
+ }
}
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ ''; #no error
+
}
=item apply_credits OPTION => VALUE ...
value of any remaining unapplied credits available for refund (see
L<FS::cust_refund>).
+Dies if there is an error.
+
=cut
sub apply_credits {
my $self = shift;
my %opt = @_;
- return 0 unless $self->total_credited;
+ 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;
+
+ $self->select_for_update; #mutex
+
+ unless ( $self->total_credited ) {
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return 0;
+ }
my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
'amount' => $amount,
} );
my $error = $cust_credit_bill->insert;
- die $error if $error;
+ if ( $error ) {
+ $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+ die $error;
+ }
redo if ($cust_bill->owed > 0);
}
- return $self->total_credited;
+ my $total_credited = $self->total_credited;
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ return $total_credited;
}
=item apply_payments
#and returns the value of any remaining unapplied payments.
+Dies if there is an error.
+
=cut
sub apply_payments {
my $self = shift;
+ 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;
+
+ $self->select_for_update; #mutex
+
#return 0 unless
my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
'amount' => $amount,
} );
my $error = $cust_bill_pay->insert;
- die $error if $error;
+ if ( $error ) {
+ $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+ die $error;
+ }
redo if ( $cust_bill->owed > 0);
}
- return $self->total_unapplied_payments;
+ my $total_unapplied_payments = $self->total_unapplied_payments;
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ return $total_unapplied_payments;
}
=item total_credited
sub check_invoicing_list {
my( $self, $arrayref ) = @_;
- foreach my $address ( @{$arrayref} ) {
+
+ foreach my $address ( @$arrayref ) {
if ($address eq 'FAX' and $self->getfield('fax') eq '') {
return 'Can\'t add FAX invoice destination with a blank FAX number.';
: $cust_main_invoice->checkdest
;
return $error if $error;
+
}
+
+ return "Email address required"
+ if $conf->exists('cust_main-require_invoicing_list_email')
+ && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
+
'';
}
sub invoicing_list_emailonly {
my $self = shift;
+ warn "$me invoicing_list_emailonly called"
+ if $DEBUG;
grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
}
+=item invoicing_list_emailonly_scalar
+
+Returns the list of email invoice recipients (invoicing_list without non-email
+destinations such as POST and FAX) as a comma-separated scalar.
+
+=cut
+
+sub invoicing_list_emailonly_scalar {
+ my $self = shift;
+ warn "$me invoicing_list_emailonly_scalar called"
+ if $DEBUG;
+ join(', ', $self->invoicing_list_emailonly);
+}
+
=item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
Returns an array of customers referred by this customer (referral_custnum set
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' );
-}
-
=item name
Returns a name string for this customer, either "Company (Last, First)" or
code2country($self->country);
}
+=item cust_status
+
=item status
Returns a status string for this customer, currently:
=cut
-sub status {
+sub status { shift->cust_status(@_); }
+
+sub cust_status {
my $self = shift;
for my $status (qw( prospect active inactive suspended cancelled )) {
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 $sth->errstr;
+ $sth->execute( ($self->custnum) x $numnum )
+ or die "Error executing 'SELECT $sql': ". $sth->errstr;
return $status if $sth->fetchrow_arrayref->[0];
}
}
+=item ucfirst_cust_status
+
+=item ucfirst_status
+
+Returns the status with the first character capitalized.
+
+=cut
+
+sub ucfirst_status { shift->ucfirst_cust_status(@_); }
+
+sub ucfirst_cust_status {
+ my $self = shift;
+ ucfirst($self->cust_status);
+}
+
=item statuscolor
Returns a hex triplet color string for this customer's status.
'cancelled' => 'FF0000', #red
);
-sub statuscolor {
+sub statuscolor { shift->cust_statuscolor(@_); }
+
+sub cust_statuscolor {
my $self = shift;
- $statuscolor{$self->status};
+ $statuscolor{$self->cust_status};
}
=back
}
+=item masked FIELD
+
+ Returns a masked version of the named field
+
+=cut
+
+sub masked {
+ my ($self, $field) = @_;
+
+ # Show last four
+
+ 'x'x(length($self->getfield($field))-4).
+ substr($self->getfield($field), (length($self->getfield($field))-4));
+
+}
+
=back
=head1 SUBROUTINES
Accepts the following options: I<search>, the string to search for. The string
will be searched for as a customer number, phone number, name or company name,
as an exact, or, in some cases, a substring or fuzzy match (see the source code
-for the exact heuristics used).
+for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
+skip fuzzy matching when an exact match is found.
Any additional options are treated as an additional qualifier on the search
(i.e. I<agentnum>).
my @cust_main = ();
+ my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
my $search = delete $options{'search'};
( my $alphanum_search = $search ) =~ s/\W//g;
#always do substring & fuzzy,
#getting complains searches are not returning enough
- #unless ( @cust_main ) { #no exact match, trying substring/fuzzy
+ unless ( @cust_main && $skip_fuzzy ) { #no exact match, trying substring/fuzzy
#still some false laziness w/ search/cust_main.cgi
FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
}
- #}
+ }
#eliminate duplicates
my %saw = ();
svc_acct.username svc_acct._password
);
$payby = 'BILL';
+ } elsif ( $format eq 'extended-plus_company' ) {
+ @fields = qw( agent_custid refnum
+ last first company address1 address2 city state zip country
+ daytime night
+ ship_last ship_first ship_company ship_address1 ship_address2
+ ship_city ship_state ship_zip ship_country
+ payinfo paycvv paydate
+ invoicing_list
+ cust_pkg.pkgpart
+ svc_acct.username svc_acct._password
+ );
+ $payby = 'BILL';
} else {
die "unknown format $format";
}
my %svc_acct = ();
foreach my $field ( @fields ) {
- if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|expire|cancel)$/ ) {
+ if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) {
#$cust_pkg{$1} = str2time( shift @$columns );
if ( $1 eq 'pkgpart' ) {
my $part_pkg = $cust_pkg->part_pkg;
unless ( $part_pkg ) {
$dbh->rollback if $oldAutoCommit;
- return "unknown pkgnum ". $cust_pkg{'pkgpart'};
+ return "unknown pkgpart: ". $cust_pkg{'pkgpart'};
}
$svc_acct{svcpart} = $part_pkg->svcpart( 'svc_acct' );
push @svc_acct, new FS::svc_acct ( \%svc_acct )
return "can't bill customer for $line: $error";
}
- $cust_main->apply_payments_and_credits;
-
+ $error = $cust_main->apply_payments_and_credits;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't bill customer for $line: $error";
+ }
+
$error = $cust_main->collect();
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
-Sends a templated email notification to the customer (see L<Text::Template).
+Sends a templated email notification to the customer (see L<Text::Template>).
OPTIONS is a hash and may include
}
+=item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
+
+Generates a templated notification to the customer (see L<Text::Template>).
+
+OPTIONS is a hash and may include
+
+I<extra_fields> - a hashref of name/value pairs which will be substituted
+ into the template. These values may override values mentioned below
+ and those from the customer record.
+
+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
+
+=cut
+
+sub generate_letter {
+ my ($self, $template, %options) = @_;
+
+ return unless $conf->exists($template);
+
+ my $letter_template = new Text::Template
+ ( TYPE => 'ARRAY',
+ SOURCE => [ map "$_\n", $conf->config($template)],
+ DELIMITERS => [ '[@--', '--@]' ],
+ )
+ or die "can't create new Text::Template object: Text::Template::ERROR";
+
+ $letter_template->compile()
+ 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';
+ 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}->{$_};
+ }
+
+ unless(exists($letter_data{returnaddress})){
+ my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
+ $self->_agent_template)
+ );
+
+ $letter_data{returnaddress} = length($retadd) ? $retadd : '~';
+ }
+
+ $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
+
+ my $dir = $FS::UID::conf_dir."cache.". $FS::UID::datasrc;
+ my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
+ DIR => $dir,
+ SUFFIX => '.tex',
+ UNLINK => 0,
+ ) or die "can't open temp file: $!\n";
+
+ $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
+ close $fh;
+ $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
+ return $1;
+}
+
+=item print_ps TEMPLATE
+
+Returns an postscript letter filled in from TEMPLATE, as a scalar.
+
+=cut
+
+sub print_ps {
+ my $self = shift;
+ my $file = $self->generate_letter(@_);
+ FS::Misc::generate_ps($file);
+}
+
+=item print TEMPLATE
+
+Prints the filled in template.
+
+TEMPLATE is the name of a L<Text::Template> to fill in and print.
+
+=cut
+
+sub queueable_print {
+ my %opt = @_;
+
+ my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
+ or die "invalid customer number: " . $opt{custvnum};
+
+ my $error = $self->print( $opt{template} );
+ die $error if $error;
+}
+
+sub print {
+ my ($self, $template) = (shift, shift);
+ do_print [ $self->print_ps($template) ];
+}
+
+sub agent_template {
+ my $self = shift;
+ $self->_agent_plandata('agent_templatename');
+}
+
+sub agent_invoice_from {
+ my $self = shift;
+ $self->_agent_plandata('agent_invoice_from');
+}
+
+sub _agent_plandata {
+ my( $self, $option ) = @_;
+
+ my $regexp = '';
+ if ( driver_name =~ /^Pg/i ) {
+ $regexp = '~';
+ } elsif ( driver_name =~ /^mysql/i ) {
+ $regexp = 'REGEXP';
+ } else {
+ die "don't know how to use regular expressions in ". driver_name. " databases";
+ }
+
+ my $part_bill_event = qsearchs( 'part_bill_event',
+ {
+ 'payby' => $self->payby,
+ 'plan' => 'send_agent',
+ 'plandata' => { 'op' => $regexp,
+ 'value' => "(^|\n)agentnum ".
+ '([0-9]*, )*'.
+ $self->agentnum.
+ '(, [0-9]*)*'.
+ "(\n|\$)",
+ },
+ },
+ '',
+ 'ORDER BY seconds LIMIT 1'
+ );
+
+ return '' unless $part_bill_event;
+
+ if ( $part_bill_event->plandata =~ /^$option (.*)$/m ) {
+ return $1;
+ } else {
+ warn "can't parse part_bill_event eventpart#". $part_bill_event->eventpart.
+ " plandata for $option";
+ return '';
+ }
+
+}
+
=back
=head1 BUGS
Birthdates rely on negative epoch values.
+The payby for card/check batches is broken. With mixed batching, bad
+things will happen.
+
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
projects / freeside.git / blobdiff