use Scalar::Util qw( blessed );
use List::Util qw( min );
use Time::Local qw(timelocal);
+use Storable qw(thaw);
+use MIME::Base64;
use Data::Dumper;
use Tie::IxHash;
use Digest::MD5 qw(md5_base64);
use FS::part_pkg_taxrate;
use FS::agent;
use FS::cust_main_invoice;
+use FS::cust_tag;
use FS::cust_credit_bill;
use FS::cust_bill_pay;
use FS::prepay_credit;
use FS::part_pkg;
use FS::part_event;
use FS::part_event_condition;
+use FS::part_export;
#use FS::cust_event;
use FS::type_pkgs;
use FS::payment_gateway;
@fuzzyfields = ( 'first', 'last', 'company', 'address1' );
@encrypted_fields = ('payinfo', 'paycvv');
-sub nohistory_fields { ('paycvv'); }
+sub nohistory_fields { ('payinfo', 'paycvv'); }
@paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
$self->invoicing_list( $invoicing_list );
}
+ warn " setting customer tags\n"
+ if $DEBUG > 1;
+
+ foreach my $tagnum ( @{ $self->tagnum || [] } ) {
+ my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
+ 'custnum' => $self->custnum };
+ my $error = $cust_tag->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ 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 cust_main_exemption\n"
if $DEBUG > 1;
}
}
+ # cust_main exports!
+ warn " exporting\n" if $DEBUG > 1;
+
+ my $export_args = $options{'export_args'} || [];
+
+ my @part_export =
+ map qsearch( 'part_export', {exportnum=>$_} ),
+ $conf->config('cust_main-exports'); #, $agentnum
+
+ foreach my $part_export ( @part_export ) {
+ my $error = $part_export->export_insert($self, @$export_args);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ". $part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+
+ #foreach my $depend_jobnum ( @$depend_jobnums ) {
+ # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
+ # if $DEBUG;
+ # foreach my $jobnum ( @jobnums ) {
+ # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
+ # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
+ # if $DEBUG;
+ # my $error = $queue->depend_insert($depend_jobnum);
+ # if ( $error ) {
+ # $dbh->rollback if $oldAutoCommit;
+ # return "error queuing job dependancy: $error";
+ # }
+ # }
+ # }
+ #
+ #}
+ #
+ #if ( exists $options{'jobnums'} ) {
+ # push @{ $options{'jobnums'} }, @jobnums;
+ #}
+
warn " insert complete; committing transaction\n"
if $DEBUG > 1;
}
-=item delete NEW_CUSTNUM
+=item delete [ OPTION => VALUE ... ]
This deletes the customer. If there is an error, returns the error, otherwise
returns false.
customer's packages (see L</cancel>).
If the customer has any uncancelled packages, you need to pass a new (valid)
-customer number for those packages to be transferred to. Cancelled packages
-will be deleted. Did I mention that this is NOT what you want when a customer
-cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
+customer number for those packages to be transferred to, as the "new_customer"
+option. Cancelled packages will be deleted. Did I mention that this is NOT
+what you want when a customer cancels service and that you really should be
+looking at L<FS::cust_pkg/cancel>?
You can't delete a customer with invoices (see L<FS::cust_bill>),
-or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
-refunds (see L<FS::cust_refund>).
+statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
+payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
+set the "delete_financials" option to a true value.
=cut
sub delete {
- my $self = shift;
+ my( $self, %opt ) = @_;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- if ( $self->cust_bill ) {
- $dbh->rollback if $oldAutoCommit;
- return "Can't delete a customer with invoices";
- }
- if ( $self->cust_credit ) {
- $dbh->rollback if $oldAutoCommit;
- return "Can't delete a customer with credits";
+ if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't delete a master agent customer";
}
- if ( $self->cust_pay ) {
- $dbh->rollback if $oldAutoCommit;
- return "Can't delete a customer with payments";
+
+ #use FS::access_user
+ if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't delete a master employee customer";
}
- if ( $self->cust_refund ) {
- $dbh->rollback if $oldAutoCommit;
- return "Can't delete a customer with refunds";
+
+ tie my %financial_tables, 'Tie::IxHash',
+ 'cust_bill' => 'invoices',
+ 'cust_statement' => 'statements',
+ 'cust_credit' => 'credits',
+ 'cust_pay' => 'payments',
+ 'cust_refund' => 'refunds',
+ ;
+
+ foreach my $table ( keys %financial_tables ) {
+
+ my @records = $self->$table();
+
+ if ( @records && ! $opt{'delete_financials'} ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't delete a customer with ". $financial_tables{$table};
+ }
+
+ foreach my $record ( @records ) {
+ my $error = $record->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error deleting ". $financial_tables{$table}. ": $error\n";
+ }
+ }
+
}
my @cust_pkg = $self->ncancelled_pkgs;
if ( @cust_pkg ) {
- my $new_custnum = shift;
+ my $new_custnum = $opt{'new_custnum'};
unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
$dbh->rollback if $oldAutoCommit;
return "Invalid new customer number: $new_custnum";
}
}
- foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
- qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
- ) {
- my $error = $cust_main_invoice->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
+ #cust_tax_adjustment in financials?
+ #cust_pay_pending? ouch
+ #cust_recon?
+ foreach my $table (qw(
+ cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
+ cust_location cust_main_note cust_tax_adjustment
+ cust_pay_void cust_pay_batch queue cust_tax_exempt
+ )) {
+ foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
+ my $error = $record->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
}
}
- foreach my $cust_main_exemption (
- qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } )
- ) {
- my $error = $cust_main_exemption->delete;
- if ( $error ) {
+ my $sth = $dbh->prepare(
+ 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
+ ) or do {
+ my $errstr = $dbh->errstr;
+ $dbh->rollback if $oldAutoCommit;
+ return $errstr;
+ };
+ $sth->execute($self->custnum) or do {
+ my $errstr = $sth->errstr;
+ $dbh->rollback if $oldAutoCommit;
+ return $errstr;
+ };
+
+ #tickets
+
+ my $ticket_dbh = '';
+ if ($conf->config('ticket_system') eq 'RT_Internal') {
+ $ticket_dbh = $dbh;
+ } elsif ($conf->config('ticket_system') eq 'RT_External') {
+ my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
+ $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
+ #or die "RT_External DBI->connect error: $DBI::errstr\n";
+ }
+
+ if ( $ticket_dbh ) {
+
+ my $ticket_sth = $ticket_dbh->prepare(
+ 'DELETE FROM Links WHERE Target = ?'
+ ) or do {
+ my $errstr = $ticket_dbh->errstr;
$dbh->rollback if $oldAutoCommit;
- return $error;
- }
+ return $errstr;
+ };
+ $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
+ or do {
+ my $errstr = $ticket_sth->errstr;
+ $dbh->rollback if $oldAutoCommit;
+ return $errstr;
+ };
+
+ #check and see if the customer is the only link on the ticket, and
+ #if so, set the ticket to deleted status in RT?
+ #maybe someday, for now this will at least fix tickets not displaying
+
}
+ #delete the customer record
+
my $error = $self->SUPER::delete;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
+ # cust_main exports!
+
+ #my $export_args = $options{'export_args'} || [];
+
+ my @part_export =
+ map qsearch( 'part_export', {exportnum=>$_} ),
+ $conf->config('cust_main-exports'); #, $agentnum
+
+ foreach my $part_export ( @part_export ) {
+ my $error = $part_export->export_delete( $self ); #, @$export_args);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ". $part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
$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
+ foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
+ my $error = $cust_tag->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ foreach my $tagnum ( @{ $self->tagnum || [] } ) {
+ my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
+ 'custnum' => $self->custnum };
+ my $error = $cust_tag->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ }
+
my %options = @param;
my $tax_exemption = delete $options{'tax_exemption'};
}
- if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
- grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
+ if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
+ && ( ( $self->get('payinfo') ne $old->get('payinfo')
+ && $self->get('payinfo') !~ /^99\d{14}$/
+ )
+ || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
+ )
+ )
+ {
+
# card/check/lec info has changed, want to retry realtime_ invoice events
my $error = $self->retry_realtime;
if ( $error ) {
}
}
+ # cust_main exports!
+
+ my $export_args = $options{'export_args'} || [];
+
+ my @part_export =
+ map qsearch( 'part_export', {exportnum=>$_} ),
+ $conf->config('cust_main-exports'); #, $agentnum
+
+ foreach my $part_export ( @part_export ) {
+ my $error = $part_export->export_replace( $self, $old, @$export_args);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ". $part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
# bad idea to disable, causes billing to fail because of no tax rates later
-# unless ( $import ) {
+# except we don't fail any more
+ unless ( $import ) {
unless ( qsearch('cust_main_county', {
'country' => $self->country,
'state' => '',
'country' => $self->country,
} );
}
-# }
+ }
$error =
$self->ut_phonen('daytime', $self->country)
# If it is encrypted and the private key is not availaible then we can't
# check the credit card.
-
- my $check_payinfo = 1;
-
- if ($self->is_encrypted($self->payinfo)) {
- $check_payinfo = 0;
- }
+ my $check_payinfo = ! $self->is_encrypted($self->payinfo);
if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
or return gettext('invalid_card'); # . ": ". $self->payinfo;
return gettext('unknown_card_type')
- if cardtype($self->payinfo) eq "Unknown";
+ if $self->payinfo !~ /^99\d{14}$/ #token
+ && cardtype($self->payinfo) eq "Unknown";
my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
if ( $ban ) {
return 1 if !$a_num_cust_svc && $b_num_cust_svc;
my @a_cust_svc = $a->cust_svc;
my @b_cust_svc = $b->cust_svc;
+ return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
+ return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
+ return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
$a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
}
qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
}
+=item agent_name
+
+Returns the agent name (see L<FS::agent>) for this customer.
+
+=cut
+
+sub agent_name {
+ my $self = shift;
+ $self->agent->agent;
+}
+
+=item cust_tag
+
+Returns any tags associated with this customer, as FS::cust_tag objects,
+or an empty list if there are no tags.
+
+=cut
+
+sub cust_tag {
+ my $self = shift;
+ qsearch('cust_tag', { 'custnum' => $self->custnum } );
+}
+
+=item part_tag
+
+Returns any tags associated with this customer, as FS::part_tag objects,
+or an empty list if there are no tags.
+
+=cut
+
+sub part_tag {
+ my $self = shift;
+ map $_->part_tag, $self->cust_tag;
+}
+
+
=item cust_class
Returns the customer class, as an FS::cust_class object, or the empty string
Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
+=item job
+
+Optional FS::queue entry to receive status updates.
+
=back
Options are passed to the B<bill> and B<collect> methods verbatim, so all
#pre-printing invoices
$options{'actual_time'} ||= time;
+ my $job = $options{'job'};
+ $job->update_statustext('0,cleaning expired packages') if $job;
$error = $self->cancel_expired_pkgs( $options{actual_time} );
if ( $error ) {
$error = "Error expiring custnum ". $self->custnum. ": $error";
else { warn $error; }
}
+ $job->update_statustext('20,billing packages') if $job;
$error = $self->bill( %options );
if ( $error ) {
$error = "Error billing custnum ". $self->custnum. ": $error";
else { warn $error; }
}
+ $job->update_statustext('50,applying payments and credits') if $job;
$error = $self->apply_payments_and_credits;
if ( $error ) {
$error = "Error applying custnum ". $self->custnum. ": $error";
else { warn $error; }
}
+ $job->update_statustext('70,running collection events') if $job;
unless ( $conf->exists('cancelled_cust-noevents')
&& ! $self->num_ncancelled_pkgs
) {
else { warn $error; }
}
}
+ $job->update_statustext('100,finished') if $job;
'';
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
+ warn "$me acquiring lock on customer ". $self->custnum. "\n"
+ if $DEBUG;
+
$self->select_for_update; #mutex
+ warn "$me running pre-bill events for customer ". $self->custnum. "\n"
+ if $DEBUG;
+
my $error = $self->do_cust_event(
'debug' => ( $options{'debug'} || 0 ),
'time' => $invoice_time,
return $error;
}
+ warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
+ if $DEBUG;
+
#keep auto-charge and non-auto-charge line items separate
my @passes = ( '', 'no_auto' );
my $real_pkgpart = $cust_pkg->pkgpart;
my %hash = $cust_pkg->hash;
- foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
+ # we could implement this bit as FS::part_pkg::has_hidden, but we already
+ # suffer from performance issues
+ $options{has_hidden} = 0;
+ my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked;
+ $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
+
+ foreach my $part_pkg ( @part_pkg ) {
$cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
- my @cust_bill_pkg = @{ $cust_bill_pkg{$pass} };
+ my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
next unless @cust_bill_pkg; #don't create an invoice w/o line items
} elsif ( $postal_pkg ) {
my $real_pkgpart = $postal_pkg->pkgpart;
- foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
+ # we could implement this bit as FS::part_pkg::has_hidden, but we already
+ # suffer from performance issues
+ $options{has_hidden} = 0;
+ my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
+ $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
+
+ foreach my $part_pkg ( @part_pkg ) {
my %postal_options = %options;
delete $postal_options{cancel};
my $error =
}
}
+ # it's silly to have a zero value postal_pkg, but....
+ @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
+
}
}
''; #no error
}
+#discard bundled packages of 0 value
+sub _omit_zero_value_bundles {
+
+ my @cust_bill_pkg = ();
+ my @cust_bill_pkg_bundle = ();
+ my $sum = 0;
+
+ foreach my $cust_bill_pkg ( @_ ) {
+ if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) {
+ push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0;
+ @cust_bill_pkg_bundle = ();
+ $sum = 0;
+ }
+ $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur;
+ push @cust_bill_pkg_bundle, $cust_bill_pkg;
+ }
+ push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0;
+
+ (@cust_bill_pkg);
+
+}
+
=item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
This is a weird one. Perhaps it should not even be exposed.
my %param = ( 'precommit_hooks' => $precommit_hooks,
'increment_next_bill' => $increment_next_bill,
'discounts' => \@discounts,
+ 'real_pkgpart' => $real_pkgpart,
);
my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
# If $cust_pkg has been modified, update it (if we're a real pkgpart)
###
- if ( $lineitems ) {
+ if ( $lineitems || $options{has_hidden} ) {
if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
# hmm.. and if just the options are modified in some weird price plan?
return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
}
- if ( $setup != 0 || $recur != 0 ) {
+ if ( $setup != 0 ||
+ $recur != 0 ||
+ !$part_pkg->hidden && $options{has_hidden} ) #include some $0 lines
+ {
warn " charges (setup=$setup, recur=$recur); adding line items\n"
if $DEBUG > 1;
my @display = ();
my $separate = $conf->exists('separate_usage');
- my $usage_mandate = $cust_pkg->part_pkg->option('usage_mandate', 'Hush!');
- if ( $separate || $cust_bill_pkg->hidden || $usage_mandate ) {
+ my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart };
+ my $usage_mandate = $temp_pkg->part_pkg->option('usage_mandate', 'Hush!');
+ my $section = $temp_pkg->part_pkg->categoryname;
+ if ( $separate || $section || $usage_mandate ) {
- my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart };
- my %hash = $cust_bill_pkg->hidden # maybe for all bill linked?
- ? ( 'section' => $temp_pkg->part_pkg->categoryname )
- : ();
+ my %hash = ( 'section' => $section );
- my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
- my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
+ $section = $temp_pkg->part_pkg->option('usage_section', 'Hush!');
+ my $summary = $temp_pkg->part_pkg->option('summarize_usage', 'Hush!');
if ( $separate ) {
push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
push @display, new FS::cust_bill_pkg_display { type => 'R', %hash };
$hash{post_total} = 'Y';
}
- $hash{section} = $section if ($separate || $usage_mandate);
- push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
+ if ($separate || $usage_mandate) {
+ $hash{section} = $section if ($separate || $usage_mandate);
+ push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
+ }
}
$cust_bill_pkg->set('display', \@display);
}
}
- my $error = $self->do_cust_event(
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ #never want to roll back an event just because it returned an error
+ local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
+
+ $self->do_cust_event(
'debug' => ( $options{'debug'} || 0 ),
'time' => $invoice_time,
'check_freq' => $options{'check_freq'},
'stage' => 'collect',
);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
}
return $due_cust_event;
}
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ #never want to roll back an event just because it or a different one
+ # returned an error
+ local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
+
foreach my $cust_event ( @$due_cust_event ) {
#XXX lock event
unless ( $cust_event->test_conditions( 'time' => $time ) ) {
#don't leave stray "new/locked" records around
my $error = $cust_event->delete;
- if ( $error ) {
- #gah, even with transactions
- $dbh->commit if $oldAutoCommit; #well.
- return $error;
- }
+ return $error if $error;
next;
}
warn " running cust_event ". $cust_event->eventnum. "\n"
if $DEBUG > 1;
-
#if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
if ( my $error = $cust_event->do_event() ) {
#XXX wtf is this? figure out a proper dealio with return value
#from do_event
- # gah, even with transactions.
- $dbh->commit if $oldAutoCommit; #well.
- return $error;
- }
+ return $error;
+ }
}
}
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
}
? $cust_X->invnum
: 0
}++
- or $cust_event->part_event->eventtable eq 'cust_bill'
- && ! $cust_X->owed;
-
- my $error = $cust_event->retry;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error scheduling event for retry: $error";
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-# some horrid false laziness here to avoid refactor fallout
-# eventually realtime realtime_bop and realtime_refund_bop should go
-# away and be replaced by _new_realtime_bop and _new_realtime_refund_bop
-
-=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>, 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,
-if set, will override the value from the customer record.
-
-I<description> is a free-text field passed to the gateway. It defaults to
-the value defined by the business-onlinepayment-description configuration
-option, or "Internet services" if that is unset.
-
-If an I<invnum> is specified, this payment (if successful) is applied to the
-specified invoice. If you don't specify an I<invnum> you might want to
-call the B<apply_payments> method or set the I<apply> option.
-
-I<apply> can be set to true to apply a resulting payment.
-
-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)
-
-=cut
-
-sub realtime_bop {
- my $self = shift;
-
- return $self->_new_realtime_bop(@_)
- if $self->_new_bop_required();
-
- my($method, $amount);
- my %options = ();
- if (ref($_[0]) eq 'HASH') {
- %options = %{$_[0]};
- $method = $options{method};
- $amount = $options{amount};
- } else {
- ( $method, $amount ) = ( shift, shift );
- %options = @_;
- }
- if ( $DEBUG ) {
- warn "$me realtime_bop: $method $amount\n";
- warn " $_ => $options{$_}\n" foreach keys %options;
- }
-
- return "Amount must be greater than 0" unless $amount > 0;
-
- unless ( $options{'description'} ) {
- if ( $conf->exists('business-onlinepayment-description') ) {
- my $dtempl = $conf->config('business-onlinepayment-description');
-
- my $agent = $self->agent->agent;
- #$pkgs... not here
- $options{'description'} = eval qq("$dtempl");
- } else {
- $options{'description'} = 'Internet services';
- }
- }
-
- return $self->fake_bop($method, $amount, %options) if $options{'fake'};
-
- eval "use Business::OnlinePayment";
- die $@ if $@;
-
- my $payinfo = exists($options{'payinfo'})
- ? $options{'payinfo'}
- : $self->payinfo;
-
- my %method2payby = (
- 'CC' => 'CARD',
- 'ECHECK' => 'CHEK',
- 'LEC' => 'LECB',
- );
-
- ###
- # check for banned credit card/ACH
- ###
-
- my $ban = qsearchs('banned_pay', {
- 'payby' => $method2payby{$method},
- 'payinfo' => md5_base64($payinfo),
- } );
- return "Banned credit card" if $ban;
-
- ###
- # set taxclass and trans_is_recur based on invnum if there is one
- ###
-
- my $taxclass = '';
- my $trans_is_recur = 0;
- if ( $options{'invnum'} ) {
-
- my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
- die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
-
- my @part_pkg =
- map { $_->part_pkg }
- grep { $_ }
- map { $_->cust_pkg }
- $cust_bill->cust_bill_pkg;
-
- my @taxclasses = map $_->taxclass, @part_pkg;
- $taxclass = $taxclasses[0]
- unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
- #different taxclasses
- $trans_is_recur = 1
- if grep { $_->freq ne '0' } @part_pkg;
-
- }
-
- ###
- # select a gateway
- ###
-
- #look for an agent gateway override first
- my $cardtype;
- if ( $method eq 'CC' ) {
- $cardtype = cardtype($payinfo);
- } elsif ( $method eq 'ECHECK' ) {
- $cardtype = 'ACH';
- } else {
- $cardtype = $method;
- }
-
- my $override =
- qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
- cardtype => $cardtype,
- taxclass => $taxclass, } )
- || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
- cardtype => '',
- taxclass => $taxclass, } )
- || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
- cardtype => $cardtype,
- taxclass => '', } )
- || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
- cardtype => '',
- taxclass => '', } );
-
- my $payment_gateway = '';
- my( $processor, $login, $password, $action, @bop_options );
- if ( $override ) { #use a payment gateway override
-
- $payment_gateway = $override->payment_gateway;
-
- $processor = $payment_gateway->gateway_module;
- $login = $payment_gateway->gateway_username;
- $password = $payment_gateway->gateway_password;
- $action = $payment_gateway->gateway_action;
- @bop_options = $payment_gateway->options;
-
- } else { #use the standard settings from the config
-
- ( $processor, $login, $password, $action, @bop_options ) =
- $self->default_payment_gateway($method);
-
- }
-
- ###
- # massage data
- ###
-
- my $address = exists($options{'address1'})
- ? $options{'address1'}
- : $self->address1;
- my $address2 = exists($options{'address2'})
- ? $options{'address2'}
- : $self->address2;
- $address .= ", ". $address2 if length($address2);
-
- my $o_payname = exists($options{'payname'})
- ? $options{'payname'}
- : $self->payname;
- my($payname, $payfirst, $paylast);
- if ( $o_payname && $method ne 'ECHECK' ) {
- ($payname = $o_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 = $self->invoicing_list_emailonly;
- if ( $conf->exists('emailinvoiceautoalways')
- || $conf->exists('emailinvoiceauto') && ! @invoicing_list
- || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
- push @invoicing_list, $self->all_emails;
- }
-
- my $email = ($conf->exists('business-onlinepayment-email-override'))
- ? $conf->config('business-onlinepayment-email-override')
- : $invoicing_list[0];
-
- my %content = ();
-
- my $payip = exists($options{'payip'})
- ? $options{'payip'}
- : $self->payip;
- $content{customer_ip} = $payip
- if length($payip);
-
- $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;
- $paydate = exists($options{'paydate'})
- ? $options{'paydate'}
- : $self->paydate;
- $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
- $content{expiration} = "$2/$1";
-
- my $paycvv = exists($options{'paycvv'})
- ? $options{'paycvv'}
- : $self->paycvv;
- $content{cvv2} = $paycvv
- if length($paycvv);
-
- my $paystart_month = exists($options{'paystart_month'})
- ? $options{'paystart_month'}
- : $self->paystart_month;
-
- my $paystart_year = exists($options{'paystart_year'})
- ? $options{'paystart_year'}
- : $self->paystart_year;
-
- $content{card_start} = "$paystart_month/$paystart_year"
- if $paystart_month && $paystart_year;
-
- my $payissue = exists($options{'payissue'})
- ? $options{'payissue'}
- : $self->payissue;
- $content{issue_number} = $payissue if $payissue;
-
- if ( $self->_bop_recurring_billing( 'payinfo' => $payinfo,
- 'trans_is_recur' => $trans_is_recur,
- )
- )
- {
- $content{recurring_billing} = 'YES';
- $content{acct_code} = 'rebill'
- if $conf->exists('credit_card-recurring_billing_acct_code');
- }
-
- } elsif ( $method eq 'ECHECK' ) {
- ( $content{account_number}, $content{routing_code} ) =
- split('@', $payinfo);
- $content{bank_name} = $o_payname;
- $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;
- } elsif ( $method eq 'LEC' ) {
- $content{phone} = $payinfo;
- }
-
- ###
- # 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,
- 'recurring_billing' => $content{recurring_billing},
- 'pkgnum' => $options{'pkgnum'},
- 'status' => 'new',
- 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
- };
- $cust_pay_pending->payunique( $options{payunique} )
- if defined($options{payunique}) && 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 );
- $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' => ( exists($options{'city'})
- ? $options{'city'}
- : $self->city ),
- 'state' => ( exists($options{'state'})
- ? $options{'state'}
- : $self->state ),
- 'zip' => ( exists($options{'zip'})
- ? $options{'zip'}
- : $self->zip ),
- 'country' => ( exists($options{'country'})
- ? $options{'country'}
- : $self->country ),
- 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
- 'email' => $email,
- '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;
-
- #config?
- my $BOP_TESTING = 0;
- my $BOP_TESTING_SUCCESS = 1;
-
- unless ( $BOP_TESTING ) {
- $transaction->submit();
- } else {
- if ( $BOP_TESTING_SUCCESS ) {
- $transaction->is_success(1);
- $transaction->authorization('fake auth');
- } else {
- $transaction->is_success(0);
- $transaction->error_message('fake failure');
- }
- }
-
- 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
- : '';
-
- 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 successful but capture failed, custnum #".
- $self->custnum. ': '. $capture->result_code.
- ": ". $capture->error_message;
- warn $e;
- return $e;
- }
-
- }
-
- $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
- ###
-
- #false laziness w/misc/process/payment.cgi - check both to make sure working
- # correctly
- if ( defined $self->dbdef_table->column('paycvv')
- && length($self->paycvv)
- && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
- ) {
- my $error = $self->remove_cvv;
- if ( $error ) {
- warn "WARNING: error removing cvv: $error\n";
- }
- }
-
- ###
- # result handling
- ###
-
- if ( $transaction->is_success() ) {
-
- my $paybatch = '';
- if ( $payment_gateway ) { # agent override
- $paybatch = $payment_gateway->gatewaynum. '-';
- }
-
- $paybatch .= "$processor:". $transaction->authorization;
-
- $paybatch .= ':'. $transaction->order_number
- if $transaction->can('order_number')
- && length($transaction->order_number);
-
- my $cust_pay = new FS::cust_pay ( {
- 'custnum' => $self->custnum,
- 'invnum' => $options{'invnum'},
- 'paid' => $amount,
- '_date' => '',
- 'payby' => $method2payby{$method},
- 'payinfo' => $payinfo,
- 'paybatch' => $paybatch,
- 'paydate' => $paydate,
- 'pkgnum' => $options{'pkgnum'},
- } );
- #doesn't hurt to know, even though the dup check is in cust_pay_pending now
- $cust_pay->payunique( $options{payunique} )
- if defined($options{payunique}) && 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( $options{'manual'} ?
- ( 'manual' => 1 ) : ()
- );
- if ( $error2 ) {
- # 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 ) - pending payment saved as paypendingnum ".
- $cust_pay_pending->paypendingnum. "\n";
- warn $e;
- return $e;
- }
- }
-
- if ( $options{'paynum_ref'} ) {
- ${ $options{'paynum_ref'} } = $cust_pay->paynum;
- }
-
- $cust_pay_pending->status('done');
- $cust_pay_pending->statustext('captured');
- $cust_pay_pending->paynum($cust_pay->paynum);
- 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;
-
- if ( $options{'apply'} ) {
- my $apply_error = $self->apply_payments_and_credits;
- if ( $apply_error ) {
- warn "WARNING: error applying payment: $apply_error\n";
- #but we still should return no error cause the payment otherwise went
- #through...
- }
- }
-
- return ''; #no error
-
- }
-
- } else {
-
- my $perror = "$processor error: ". $transaction->error_message;
-
- unless ( $transaction->error_message ) {
-
- my $t_response;
- if ( $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
- && ! grep { $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 = {
- 'company_name' =>
- scalar( $conf->config('company_name', $self->agentnum ) ),
- 'company_address' =>
- join("\n", $conf->config('company_address', $self->agentnum ) ),
- 'error' => $transaction->error_message,
- };
-
- my $error = send_email(
- 'from' => $conf->config('invoice_from', $self->agentnum ),
- '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;
-
- }
-
- $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;
- }
-
-}
-
-sub _bop_recurring_billing {
- my( $self, %opt ) = @_;
-
- my $method = scalar($conf->config('credit_card-recurring_billing_flag'));
-
- if ( defined($method) && $method eq 'transaction_is_recur' ) {
-
- return 1 if $opt{'trans_is_recur'};
-
- } else {
-
- my %hash = ( 'custnum' => $self->custnum,
- 'payby' => 'CARD',
- );
-
- return 1
- if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
- || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
- $opt{'payinfo'} )
- } );
-
- }
-
- return 0;
-
-}
-
-
-=item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
-
-Refunds 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<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<amount> defaults to the original amount of the payment if not specified.
-
-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,
-the normal attempt is made to "refund" ("credit") the transaction via the
-gateway is attempted.
-
-#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.
-
-#If an I<invnum> is specified, this payment (if successful) is applied to the
-#specified invoice. If you don't specify an I<invnum> you might want to
-#call the B<apply_payments> method.
-
-=cut
-
-#some false laziness w/realtime_bop, not enough to make it worth merging
-#but some useful small subs should be pulled out
-sub realtime_refund_bop {
- my $self = shift;
-
- return $self->_new_realtime_refund_bop(@_)
- if $self->_new_bop_required();
-
- my( $method, %options ) = @_;
- if ( $DEBUG ) {
- warn "$me realtime_refund_bop: $method refund\n";
- warn " $_ => $options{$_}\n" foreach keys %options;
- }
-
- eval "use Business::OnlinePayment";
- die $@ if $@;
-
- ###
- # look up the original payment and optionally a gateway for that payment
- ###
-
- my $cust_pay = '';
- my $amount = $options{'amount'};
-
- my( $processor, $login, $password, @bop_options ) ;
- my( $auth, $order_number ) = ( '', '', '' );
-
- if ( $options{'paynum'} ) {
-
- warn " paynum: $options{paynum}\n" if $DEBUG > 1;
- $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
- or return "Unknown paynum $options{'paynum'}";
- $amount ||= $cust_pay->paid;
-
- $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
- or return "Can't parse paybatch for paynum $options{'paynum'}: ".
- $cust_pay->paybatch;
- my $gatewaynum = '';
- ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
-
- if ( $gatewaynum ) { #gateway for the payment to be refunded
-
- my $payment_gateway =
- qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
- die "payment gateway $gatewaynum not found"
- unless $payment_gateway;
-
- $processor = $payment_gateway->gateway_module;
- $login = $payment_gateway->gateway_username;
- $password = $payment_gateway->gateway_password;
- @bop_options = $payment_gateway->options;
-
- } else { #try the default gateway
-
- my( $conf_processor, $unused_action );
- ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
- $self->default_payment_gateway($method);
-
- return "processor of payment $options{'paynum'} $processor does not".
- " match default processor $conf_processor"
- unless $processor eq $conf_processor;
-
- }
-
-
- } else { # didn't specify a paynum, so look for agent gateway overrides
- # like a normal transaction
-
- my $cardtype;
- if ( $method eq 'CC' ) {
- $cardtype = cardtype($self->payinfo);
- } elsif ( $method eq 'ECHECK' ) {
- $cardtype = 'ACH';
- } else {
- $cardtype = $method;
- }
- my $override =
- qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
- cardtype => $cardtype,
- taxclass => '', } )
- || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
- cardtype => '',
- taxclass => '', } );
-
- if ( $override ) { #use a payment gateway override
-
- my $payment_gateway = $override->payment_gateway;
-
- $processor = $payment_gateway->gateway_module;
- $login = $payment_gateway->gateway_username;
- $password = $payment_gateway->gateway_password;
- #$action = $payment_gateway->gateway_action;
- @bop_options = $payment_gateway->options;
-
- } else { #use the standard settings from the config
-
- my $unused_action;
- ( $processor, $login, $password, $unused_action, @bop_options ) =
- $self->default_payment_gateway($method);
-
- }
-
- }
- return "neither amount nor paynum specified" unless $amount;
-
- my %content = (
- 'type' => $method,
- 'login' => $login,
- 'password' => $password,
- 'order_number' => $order_number,
- 'amount' => $amount,
- 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
- );
- $content{authorization} = $auth
- 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
- && (
- ( 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 );
- if ( $void->can('info') ) {
- if ( $cust_pay->payby eq 'CARD'
- && $void->info('CC_void_requires_card') )
- {
- $content{'card_number'} = $cust_pay->payinfo
- } elsif ( $cust_pay->payby eq 'CHEK'
- && $void->info('ECHECK_void_requires_account') )
- {
- ( $content{'account_number'}, $content{'routing_code'} ) =
- split('@', $cust_pay->payinfo);
- $content{'name'} = $self->get('first'). ' '. $self->get('last');
- }
- }
- $void->content( 'action' => 'void', %content );
- $void->submit();
- if ( $void->is_success ) {
- my $error = $cust_pay->void($options{'reason'});
- if ( $error ) {
- # gah, even with transactions.
- my $e = 'WARNING: Card/ACH voided but database not updated - '.
- "error voiding payment: $error";
- warn $e;
- return $e;
- }
- warn " void successful\n" if $DEBUG > 1;
- return '';
- }
- }
-
- warn " void unsuccessful, trying refund\n"
- if $DEBUG > 1;
-
- #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 = $self->invoicing_list_emailonly;
- if ( $conf->exists('emailinvoiceautoalways')
- || $conf->exists('emailinvoiceauto') && ! @invoicing_list
- || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
- push @invoicing_list, $self->all_emails;
- }
-
- my $email = ($conf->exists('business-onlinepayment-email-override'))
- ? $conf->config('business-onlinepayment-email-override')
- : $invoicing_list[0];
-
- my $payip = exists($options{'payip'})
- ? $options{'payip'}
- : $self->payip;
- $content{customer_ip} = $payip
- if length($payip);
-
- my $payinfo = '';
- if ( $method eq 'CC' ) {
-
- if ( $cust_pay ) {
- $content{card_number} = $payinfo = $cust_pay->payinfo;
- (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;
- (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
- =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
- $content{expiration} = "$2/$1";
- }
-
- } elsif ( $method eq 'ECHECK' ) {
-
- 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;
- $content{customer_org} = $self->company ? 'B' : 'I';
- $content{customer_ssn} = $self->ss;
- } elsif ( $method eq 'LEC' ) {
- $content{phone} = $payinfo = $self->payinfo;
- }
-
- #then try refund
- my $refund = new Business::OnlinePayment( $processor, @bop_options );
- my %sub_content = $refund->content(
- 'action' => 'credit',
- '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,
- 'email' => $email,
- 'phone' => $self->daytime || $self->night,
- %content, #after
- );
- warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
- if $DEBUG > 1;
- $refund->submit();
-
- return "$processor error: ". $refund->error_message
- unless $refund->is_success();
-
- my %method2payby = (
- 'CC' => 'CARD',
- 'ECHECK' => 'CHEK',
- 'LEC' => 'LECB',
- );
-
- my $paybatch = "$processor:". $refund->authorization;
- $paybatch .= ':'. $refund->order_number
- if $refund->can('order_number') && $refund->order_number;
-
- while ( $cust_pay && $cust_pay->unapplied < $amount ) {
- my @cust_bill_pay = $cust_pay->cust_bill_pay;
- last unless @cust_bill_pay;
- my $cust_bill_pay = pop @cust_bill_pay;
- my $error = $cust_bill_pay->delete;
- last if $error;
- }
-
- my $cust_refund = new FS::cust_refund ( {
- 'custnum' => $self->custnum,
- 'paynum' => $options{'paynum'},
- 'refund' => $amount,
- '_date' => '',
- 'payby' => $method2payby{$method},
- 'payinfo' => $payinfo,
- 'paybatch' => $paybatch,
- 'reason' => $options{'reason'} || 'card or ACH refund',
- } );
- my $error = $cust_refund->insert;
- if ( $error ) {
- $cust_refund->paynum(''); #try again with no specific paynum
- my $error2 = $cust_refund->insert;
- if ( $error2 ) {
- # gah, even with transactions.
- my $e = 'WARNING: Card/ACH refunded but database not updated - '.
- "error inserting refund ($processor): $error2".
- " (previously tried insert with paynum #$options{'paynum'}" .
- ": $error )";
- warn $e;
- return $e;
+ or $cust_event->part_event->eventtable eq 'cust_bill'
+ && ! $cust_X->owed;
+
+ my $error = $cust_event->retry;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error scheduling event for retry: $error";
}
+
}
- ''; #no error
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
}
-# does the configuration indicate the new bop routines are required?
-
-sub _new_bop_required {
- my $self = shift;
-
- my $botpp = 'Business::OnlineThirdPartyPayment';
- return 1
- if ( ( $conf->exists('business-onlinepayment-namespace')
- && $conf->config('business-onlinepayment-namespace') eq $botpp
- )
- or scalar( grep { $_->gateway_namespace eq $botpp }
- qsearch( 'payment_gateway', { 'disabled' => '' } )
- )
- )
- ;
+=cut
- '';
-}
-
=item realtime_collect [ OPTION => VALUE ... ]
Runs a realtime credit card, ACH (electronic check) or phone bill transaction
}
-=item _realtime_bop { [ ARG => VALUE ... ] }
+=item realtime_bop { [ ARG => VALUE ... ] }
Runs a realtime credit card, ACH (electronic check) or phone bill transaction
via a Business::OnlinePayment realtime gateway. See
Available methods are: I<CC>, I<ECHECK> and I<LEC>
-Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
+Available optional arguments are: I<description>, I<invnum>, I<apply>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
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 an I<invnum> is specified, this payment (if successful) is applied to the
specified invoice. If you don't specify an I<invnum> you might want to
-call the B<apply_payments> method.
+call the B<apply_payments> method or set the I<apply> option.
+
+I<apply> can be set to true to apply a resulting payment.
I<quiet> can be set true to surpress email decline notices.
=cut
# some helper routines
+sub _bop_recurring_billing {
+ my( $self, %opt ) = @_;
+
+ my $method = scalar($conf->config('credit_card-recurring_billing_flag'));
+
+ if ( defined($method) && $method eq 'transaction_is_recur' ) {
+
+ return 1 if $opt{'trans_is_recur'};
+
+ } else {
+
+ my %hash = ( 'custnum' => $self->custnum,
+ 'payby' => 'CARD',
+ );
+
+ return 1
+ if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
+ || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
+ $opt{'payinfo'} )
+ } );
+
+ }
+
+ return 0;
+
+}
+
sub _payment_gateway {
my ($self, $options) = @_;
$options->{payment_gateway}->gatewaynum
? $options->{payment_gateway}->options
: @{ $options->{payment_gateway}->get('options') };
+
}
sub _bop_defaults {
my ($self, $options) = @_;
my %content = ();
- $content{address} = exists($options->{'address1'})
- ? $options->{'address1'}
- : $self->address1;
- my $address2 = exists($options->{'address2'})
- ? $options->{'address2'}
- : $self->address2;
- $content{address} .= ", ". $address2 if length($address2);
-
my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
$content{customer_ip} = $payip if length($payip);
( $conf->exists('business-onlinepayment-email_customer')
|| $conf->exists('business-onlinepayment-email-override') );
- $content{payfirst} = $self->getfield('first');
- $content{paylast} = $self->getfield('last');
+ my ($payname, $payfirst, $paylast);
+ if ( $options->{payname} && $options->{method} ne 'ECHECK' ) {
+ ($payname = $options->{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";
+ }
+
+ $content{last_name} = $paylast;
+ $content{first_name} = $payfirst;
- $content{account_name} = "$content{payfirst} $content{paylast}"
- if $options->{method} eq 'ECHECK';
+ $content{name} = $payname;
- $content{name} = $options->{payname};
- $content{name} = $content{account_name} if exists($content{account_name});
+ $content{address} = exists($options->{'address1'})
+ ? $options->{'address1'}
+ : $self->address1;
+ my $address2 = exists($options->{'address2'})
+ ? $options->{'address2'}
+ : $self->address2;
+ $content{address} .= ", ". $address2 if length($address2);
$content{city} = exists($options->{city})
? $options->{city}
$content{country} = exists($options->{country})
? $options->{country}
: $self->country;
+
$content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
$content{phone} = $self->daytime || $self->night;
- (%content);
+ \%content;
}
my %bop_method2payby = (
'LEC' => 'LECB',
);
-sub _new_realtime_bop {
+sub realtime_bop {
my $self = shift;
my %options = ();
# massage data
###
- my (%bop_content) = $self->_bop_content(\%options);
-
- if ( $options{method} ne 'ECHECK' ) {
- $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
- or return "Illegal payname $options{payname}";
- ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2);
- }
+ my $bop_content = $self->_bop_content(\%options);
+ return $bop_content unless ref($bop_content);
my @invoicing_list = $self->invoicing_list_emailonly;
if ( $conf->exists('emailinvoiceautoalways')
$content{account_type} = exists($options{'paytype'})
? uc($options{'paytype'}) || 'CHECKING'
: uc($self->getfield('paytype')) || 'CHECKING';
+ $content{account_name} = $self->getfield('first'). ' '.
+ $self->getfield('last');
+
$content{customer_org} = $self->company ? 'B' : 'I';
$content{state_id} = exists($options{'stateid'})
? $options{'stateid'}
'amount' => $options{amount},
#'invoice_number' => $options{'invnum'},
'customer_id' => $self->custnum,
- %bop_content,
+ %$bop_content,
'reference' => $cust_pay_pending->paypendingnum, #for now
'email' => $email,
%content, #after
my $BOP_TESTING_SUCCESS = 1;
unless ( $BOP_TESTING ) {
+ $transaction->test_transaction(1)
+ if $conf->exists('business-onlinepayment-test_transaction');
$transaction->submit();
} else {
if ( $BOP_TESTING_SUCCESS ) {
$capture->content( %capture );
+ $capture->test_transaction(1)
+ if $conf->exists('business-onlinepayment-test_transaction');
$capture->submit();
unless ( $capture->is_success ) {
}
}
+ ###
+ # Tokenize
+ ###
+
+
+ if ( $transaction->can('card_token') && $transaction->card_token ) {
+
+ $self->card_token($transaction->card_token);
+
+ if ( $options{'payinfo'} eq $self->payinfo ) {
+ $self->payinfo($transaction->card_token);
+ my $error = $self->replace;
+ if ( $error ) {
+ warn "WARNING: error storing token: $error, but proceeding anyway\n";
+ }
+ }
+
+ }
+
###
# result handling
###
'paid' => $cust_pay_pending->paid,
'_date' => '',
'payby' => $cust_pay_pending->payby,
- #'payinfo' => $payinfo,
+ 'payinfo' => $options{'payinfo'},
'paybatch' => $paybatch,
'paydate' => $cust_pay_pending->paydate,
'pkgnum' => $cust_pay_pending->pkgnum,
&& ! grep { $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 = {
- 'company_name' =>
- scalar( $conf->config('company_name', $self->agentnum ) ),
- 'company_address' =>
- join("\n", $conf->config('company_address', $self->agentnum ) ),
- 'error' => $transaction->error_message,
- };
- my $error = send_email(
- 'from' => $conf->config('invoice_from', $self->agentnum ),
- 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
- 'subject' => 'Your payment could not be processed',
- 'body' => [ $template->fill_in(HASH => $templ_hash) ],
- );
+ # Send a decline alert to the customer.
+ my $msgnum = $conf->config('decline_msgnum', $self->agentnum);
+ my $error = '';
+ if ( $msgnum ) {
+ # include the raw error message in the transaction state
+ $cust_pay_pending->setfield('error', $transaction->error_message);
+ my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
+ $error = $msg_template->send( 'cust_main' => $self,
+ 'object' => $cust_pay_pending );
+ }
+ else { #!$msgnum
+
+ 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 = {
+ 'company_name' =>
+ scalar( $conf->config('company_name', $self->agentnum ) ),
+ 'company_address' =>
+ join("\n", $conf->config('company_address', $self->agentnum ) ),
+ 'error' => $transaction->error_message,
+ };
+
+ my $error = send_email(
+ 'from' => $conf->config('invoice_from', $self->agentnum ),
+ '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;
'';
}
-=item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ]
+=item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
via a Business::OnlinePayment realtime gateway. See
#some false laziness w/realtime_bop, not enough to make it worth merging
#but some useful small subs should be pulled out
-sub _new_realtime_refund_bop {
+sub realtime_refund_bop {
my $self = shift;
my %options = ();
- if (ref($_[0]) ne 'HASH') {
+ if (ref($_[0]) eq 'HASH') {
%options = %{$_[0]};
} else {
my $method = shift;
}
}
$void->content( 'action' => 'void', %content );
+ $void->test_transaction(1)
+ if $conf->exists('business-onlinepayment-test_transaction');
$void->submit();
if ( $void->is_success ) {
my $error = $cust_pay->void($options{'reason'});
);
warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
if $DEBUG > 1;
+ $refund->test_transaction(1)
+ if $conf->exists('business-onlinepayment-test_transaction');
$refund->submit();
return "$processor error: ". $refund->error_message
my $self = shift;
my $time = shift;
-# my $custnum = $self->custnum;
-#
-# my $owed_sql = FS::cust_bill->owed_sql;
-#
-# my $sql = "
-# SELECT SUM($owed_sql) FROM cust_bill
-# WHERE custnum = $custnum
-# AND _date <= $time
-# ";
-#
-# my $sth = dbh->prepare($sql) or die dbh->errstr;
-# $sth->execute() or die $sth->errstr;
-#
-# return sprintf( '%.2f', $sth->fetchrow_arrayref->[0] );
+ my $custnum = $self->custnum;
- my $total_bill = 0;
- foreach my $cust_bill (
- grep { $_->_date <= $time }
- qsearch('cust_bill', { 'custnum' => $self->custnum, } )
- ) {
- $total_bill += $cust_bill->owed;
- }
- sprintf( "%.2f", $total_bill );
+ my $owed_sql = FS::cust_bill->owed_sql;
+
+ my $sql = "
+ SELECT SUM($owed_sql) FROM cust_bill
+ WHERE custnum = $custnum
+ AND _date <= $time
+ ";
+
+ sprintf( "%.2f", $self->scalar_sql($sql) );
}
sub total_unapplied_credits {
my $self = shift;
- my $total_credit = 0;
- $total_credit += $_->credited foreach $self->cust_credit;
- sprintf( "%.2f", $total_credit );
+
+ my $custnum = $self->custnum;
+
+ my $unapplied_sql = FS::cust_credit->unapplied_sql;
+
+ my $sql = "
+ SELECT SUM($unapplied_sql) FROM cust_credit
+ WHERE custnum = $custnum
+ ";
+
+ sprintf( "%.2f", $self->scalar_sql($sql) );
+
}
=item total_unapplied_credits_pkgnum PKGNUM
sub total_unapplied_payments {
my $self = shift;
- my $total_unapplied = 0;
- $total_unapplied += $_->unapplied foreach $self->cust_pay;
- sprintf( "%.2f", $total_unapplied );
+
+ my $custnum = $self->custnum;
+
+ my $unapplied_sql = FS::cust_pay->unapplied_sql;
+
+ my $sql = "
+ SELECT SUM($unapplied_sql) FROM cust_pay
+ WHERE custnum = $custnum
+ ";
+
+ sprintf( "%.2f", $self->scalar_sql($sql) );
+
}
=item total_unapplied_payments_pkgnum PKGNUM
sub total_unapplied_refunds {
my $self = shift;
- my $total_unapplied = 0;
- $total_unapplied += $_->unapplied foreach $self->cust_refund;
- sprintf( "%.2f", $total_unapplied );
+ my $custnum = $self->custnum;
+
+ my $unapplied_sql = FS::cust_refund->unapplied_sql;
+
+ my $sql = "
+ SELECT SUM($unapplied_sql) FROM cust_refund
+ WHERE custnum = $custnum
+ ";
+
+ sprintf( "%.2f", $self->scalar_sql($sql) );
+
}
=item balance
sub balance {
my $self = shift;
- sprintf( "%.2f",
- $self->total_owed
- + $self->total_unapplied_refunds
- - $self->total_unapplied_credits
- - $self->total_unapplied_payments
- );
+ $self->balance_date_range;
}
=item balance_date TIME
sub balance_date {
my $self = shift;
- my $time = shift;
- sprintf( "%.2f",
- $self->total_owed_date($time)
- + $self->total_unapplied_refunds
- - $self->total_unapplied_credits
- - $self->total_unapplied_payments
- );
+ $self->balance_date_range(shift);
}
-=item balance_date_range START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
+=item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
-Returns the balance for this customer, only considering invoices with date
-earlier than START_TIME, and optionally not later than END_TIME
+Returns the balance for this customer, optionally considering invoices with
+date earlier than START_TIME, and not later than END_TIME
(total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
Times are specified as SQL fragments or numeric
my $self = shift;
my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
') FROM cust_main WHERE custnum='. $self->custnum;
- sprintf( "%.2f", $self->scalar_sql($sql) );
+ sprintf( '%.2f', $self->scalar_sql($sql) );
}
=item balance_pkgnum PKGNUM
);
}
+=item cust_pay_pending_attempt
+
+Returns all payment attempts / declined payments for this customer, as pending
+payments objects (see L<FS::cust_pay_pending>), with status "done" but without
+a corresponding payment (see L<FS::cust_pay>).
+
+=cut
+
+sub cust_pay_pending_attempt {
+ my $self = shift;
+ return $self->num_cust_pay_pending_attempt unless wantarray;
+ sort { $a->_date <=> $b->_date }
+ qsearch( 'cust_pay_pending', {
+ 'custnum' => $self->custnum,
+ 'status' => 'done',
+ 'paynum' => '',
+ },
+ );
+}
+
=item num_cust_pay_pending
Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
sub num_cust_pay_pending {
my $self = shift;
- my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
- " WHERE custnum = ? AND status != 'done' ";
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute($self->custnum) or die $sth->errstr;
- $sth->fetchrow_arrayref->[0];
+ $self->scalar_sql(
+ " SELECT COUNT(*) FROM cust_pay_pending ".
+ " WHERE custnum = ? AND status != 'done' ",
+ $self->custnum
+ );
+}
+
+=item num_cust_pay_pending_attempt
+
+Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
+customer, with status "done" but without a corresp. Also called automatically when the
+cust_pay_pending method is used in a scalar context.
+
+=cut
+
+sub num_cust_pay_pending_attempt {
+ my $self = shift;
+ $self->scalar_sql(
+ " SELECT COUNT(*) FROM cust_pay_pending ".
+ " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
+ $self->custnum
+ );
}
=item cust_refund
=item prospect - No packages have ever been ordered
+=item ordered - Recurring packages all are new (not yet billed).
+
=item active - One or more recurring packages is active
=item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
sub cust_status {
my $self = shift;
- for my $status (qw( prospect active inactive suspended cancelled )) {
+ # prospect ordered active inactive suspended cancelled
+ 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;
tie %statuscolor, 'Tie::IxHash',
'prospect' => '7e0079', #'000000', #black? naw, purple
'active' => '00CC00', #green
+ 'ordered' => '009999', #teal? cyan?
'inactive' => '0000CC', #blue
'suspended' => 'FF9900', #yellow
'cancelled' => 'FF0000', #red
$select_count_pkgs;
}
-sub prospect_sql { "
- 0 = ( $select_count_pkgs )
-"; }
+sub prospect_sql {
+ " 0 = ( $select_count_pkgs ) ";
+}
+
+=item ordered_sql
+
+Returns an SQL expression identifying ordered cust_main records (customers with
+recurring packages not yet setup).
+
+=cut
+
+sub ordered_sql {
+ FS::cust_main->none_active_sql.
+ " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
+}
=item active_sql
=cut
-sub active_sql { "
- 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
- )
-"; }
+sub active_sql {
+ " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
+}
+
+=item none_active_sql
+
+Returns an SQL expression identifying cust_main records with no active
+recurring packages. This includes customers of status prospect, ordered,
+inactive, and suspended.
+
+=cut
+
+sub none_active_sql {
+ " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
+}
=item inactive_sql
=cut
-sub inactive_sql { "
- 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
- AND
- 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
-"; }
+sub inactive_sql {
+ FS::cust_main->none_active_sql.
+ " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
+}
=item susp_sql
=item suspended_sql
sub suspended_sql { susp_sql(@_); }
-sub susp_sql { "
- 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
- AND
- 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
-"; }
+sub susp_sql {
+ FS::cust_main->none_active_sql.
+ " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
+}
=item cancel_sql
=item cancelled_sql
WHERE cust_refund.custnum = cust_main.custnum )
"; }
-=item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
+=item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
-Returns an SQL fragment to retreive the balance for this customer, only
-considering invoices with date earlier than START_TIME, and optionally not
+Returns an SQL fragment to retreive the balance for this customer, optionally
+considering invoices with date earlier than START_TIME, and not
later than END_TIME (total_owed_date minus total_unapplied_credits minus
total_unapplied_payments).
(unused. obsolete?)
JOIN clause (typically used with the total option)
+=item cutoff
+
+An absolute cutoff time. Payments, credits, and refunds I<applied> after this
+time will be ignored. Note that START_TIME and END_TIME only limit the date
+range for invoices and I<unapplied> payments, credits, and refunds.
+
=back
=cut
sub balance_date_sql {
my( $class, $start, $end, %opt ) = @_;
- my $owed = FS::cust_bill->owed_sql;
- my $unapp_refund = FS::cust_refund->unapplied_sql;
- my $unapp_credit = FS::cust_credit->unapplied_sql;
- my $unapp_pay = FS::cust_pay->unapplied_sql;
+ my $cutoff = $opt{'cutoff'};
+
+ my $owed = FS::cust_bill->owed_sql($cutoff);
+ my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
+ my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
+ my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
my $j = $opt{'join'} || '';
=cut
sub unapplied_payments_date_sql {
- my( $class, $start, $end, ) = @_;
+ my( $class, $start, $end, %opt ) = @_;
+
+ my $cutoff = $opt{'cutoff'};
- my $unapp_pay = FS::cust_pay->unapplied_sql;
+ my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
'unapplied_date'=>1 );
# parse status
##
- #prospect active inactive suspended cancelled
+ #prospect ordered active inactive suspended cancelled
if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
my $method = $params->{'status'}. '_sql';
#push @where, $class->$method();
my $subject = delete $params->{subject};
my $html_body = delete $params->{html_body};
my $text_body = delete $params->{text_body};
+ my $error = '';
- my $job = delete $params->{'job'};
+ my $job = delete $params->{'job'}
+ or die "email_search_result must run from the job queue.\n";
$params->{'payby'} = [ split(/\0/, $params->{'payby'}) ]
unless ref($params->{'payby'});
my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
+ my @retry_jobs = ();
+ my $success = 0;
#eventually order+limit magic to reduce memory use?
foreach my $cust_main ( qsearch($sql_query) ) {
+ #progressbar first, so that the count is right
+ $num++;
+ if ( time - $min_sec > $last ) {
+ my $error = $job->update_statustext(
+ int( 100 * $num / $num_cust )
+ );
+ die $error if $error;
+ $last = time;
+ }
+
my $to = $cust_main->invoicing_list_emailonly_scalar;
- next unless $to;
- my $error = send_email(
- generate_email(
+ if( $to ) {
+ my @message = (
'from' => $from,
'to' => $to,
'subject' => $subject,
'html_body' => $html_body,
'text_body' => $text_body,
- )
- );
- return $error if $error;
+ );
- if ( $job ) { #progressbar foo
- $num++;
- if ( time - $min_sec > $last ) {
- my $error = $job->update_statustext(
- int( 100 * $num / $num_cust )
- );
- die $error if $error;
- $last = time;
+ $error = send_email( generate_email( @message ) );
+
+ if($error) {
+ # queue the sending of this message so that the user can see what we
+ # tried to do, and retry if desired
+ my $queue = new FS::queue {
+ 'job' => 'FS::Misc::process_send_email',
+ 'custnum' => $cust_main->custnum,
+ 'status' => 'failed',
+ 'statustext' => $error,
+ };
+ $queue->insert(@message);
+ push @retry_jobs, $queue;
+ }
+ else {
+ $success++;
}
}
+ if($success == 0 and
+ (scalar(@retry_jobs) > 10 or $num == $num_cust)
+ ) {
+ # 10 is arbitrary, but if we have enough failures, that's
+ # probably a configuration or network problem, and we
+ # abort the batch and run away screaming.
+ # We NEVER do this if anything was successfully sent.
+ $_->delete foreach (@retry_jobs);
+ return "multiple failures: '$error'\n";
+ }
+ }
+
+ if(@retry_jobs) {
+ # fail the job, but with a status message that makes it clear
+ # something was sent.
+ return "Sent $success, failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
}
return '';
}
-use Storable qw(thaw);
-use Data::Dumper;
-use MIME::Base64;
sub process_email_search_result {
my $job = shift;
#warn "$me process_re_X $method for job $job\n" if $DEBUG;
my $param = shift;
#warn join('-',keys %$param);
my $fh = $param->{filehandle};
- my @fields = @{$param->{fields}};
+ my $agentnum = $param->{agentnum};
+ my $format = $param->{format};
+
+ my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
+
+ my @fields;
+ if ( $format eq 'simple' ) {
+ @fields = qw( custnum agent_custid amount pkg );
+ } else {
+ die "unknown format $format";
+ }
eval "use Text::CSV_XS;";
die $@ if $@;
$row{$field} = shift @columns;
}
- my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
+ if ( $row{custnum} && $row{agent_custid} ) {
+ dbh->rollback if $oldAutoCommit;
+ return "can't specify custnum with agent_custid $row{agent_custid}";
+ }
+
+ my %hash = ();
+ if ( $row{agent_custid} && $agentnum ) {
+ %hash = ( 'agent_custid' => $row{agent_custid},
+ 'agentnum' => $agentnum,
+ );
+ }
+
+ if ( $row{custnum} ) {
+ %hash = ( 'custnum' => $row{custnum} );
+ }
+
+ unless ( scalar(keys %hash) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't find customer without custnum or agent_custid and agentnum";
+ }
+
+ my $cust_main = qsearchs('cust_main', { %hash } );
unless ( $cust_main ) {
$dbh->rollback if $oldAutoCommit;
- return "unknown custnum $row{'custnum'}";
+ my $custnum = $row{custnum} || $row{agent_custid};
+ return "unknown custnum $custnum";
}
if ( $row{'amount'} > 0 ) {
=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
=cut
+# a lot like cust_bill::print_latex
sub generate_letter {
my ($self, $template, %options) = @_;
$letter_data{returnaddress} = $retadd;
} elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
$letter_data{returnaddress} =
- join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
- $conf->config('company_address', $self->agentnum)
+ join( "\n", map { s/( {2,})/'~' x length($1)/eg;
+ s/$/\\\\\*/;
+ $_;
+ }
+ ( $conf->config('company_name', $self->agentnum),
+ $conf->config('company_address', $self->agentnum),
+ )
);
} else {
$letter_data{returnaddress} = '~';
$letter_data{company_name} = $conf->config('company_name', $self->agentnum);
my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
+
+ my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
+ DIR => $dir,
+ SUFFIX => '.eps',
+ UNLINK => 0,
+ ) or die "can't open temp file: $!\n";
+ print $lh $conf->config_binary('logo.eps', $self->agentnum)
+ or die "can't write temp file: $!\n";
+ close $lh;
+ $letter_data{'logo_file'} = $lh->filename;
+
my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
DIR => $dir,
SUFFIX => '.tex',
$letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
close $fh;
$fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
- return $1;
+ return ($1, $letter_data{'logo_file'});
+
}
=item print_ps TEMPLATE
sub print_ps {
my $self = shift;
- my $file = $self->generate_letter(@_);
- FS::Misc::generate_ps($file);
+ my($file, $lfile) = $self->generate_letter(@_);
+ my $ps = FS::Misc::generate_ps($file);
+ unlink($file.'.tex');
+ unlink($lfile);
+
+ $ps;
}
=item print TEMPLATE
}
+=item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
+
+Subroutine (not a method), designed to be called from the queue.
+
+Takes a list of options and values.
+
+Pulls up the customer record via the custnum option and calls bill_and_collect.
+
+=cut
+
sub queued_bill {
- ## actual sub, not a method, designed to be called from the queue.
- ## sets up the customer, and calls the bill_and_collect
my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
+
my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
- $cust_main->bill_and_collect(
- %args,
- );
+ warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
+
+ $cust_main->bill_and_collect( %args );
+}
+
+sub process_bill_and_collect {
+ my $job = shift;
+ my $param = thaw(decode_base64(shift));
+ my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
+ or die "custnum '$param->{custnum}' not found!\n";
+ $param->{'job'} = $job;
+ $param->{'fatal'} = 1; # runs from job queue, will be caught
+ $param->{'retry'} = 1;
+
+ $cust_main->bill_and_collect( %$param );
}
sub _upgrade_data { #class method
my $sth = dbh->prepare($sql) or die dbh->errstr;
$sth->execute or die $sth->errstr;
+ local($ignore_expired_card) = 1;
+ local($skip_fuzzyfiles) = 1;
$class->_upgrade_otaker(%opts);
}