require 5.006;
use strict;
-use base qw( FS::otaker_Mixin
- FS::payinfo_Mixin
- FS::cust_main_Mixin
+use base qw( FS::cust_main::Billing FS::cust_main::Billing_Realtime
+ FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
FS::Record
- );
+ );
use vars qw( @EXPORT_OK $DEBUG $me $conf
@encrypted_fields
$import $ignore_expired_card
@paytypes
);
use vars qw( $realtime_bop_decline_quiet ); #ugh
-use Safe;
use Carp;
use Exporter;
use Scalar::Util qw( blessed );
use FS::cust_pkg;
use FS::cust_svc;
use FS::cust_bill;
-use FS::cust_bill_pkg;
-use FS::cust_bill_pkg_display;
-use FS::cust_bill_pkg_tax_location;
-use FS::cust_bill_pkg_tax_rate_location;
use FS::cust_pay;
use FS::cust_pay_pending;
use FS::cust_pay_void;
use FS::cust_class;
use FS::cust_main_exemption;
use FS::cust_tax_adjustment;
-use FS::tax_rate;
-use FS::tax_rate_location;
use FS::cust_tax_location;
-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::queue;
use FS::part_pkg;
@EXPORT_OK = qw( smart_search );
-$realtime_bop_decline_quiet = 0;
+$realtime_bop_decline_quiet = 0; #move to Billing_Realtime
# 1 is mostly method/subroutine entry and options
# 2 traces progress of some operations
: '';
}
+=item BILLING METHODS
-=item bill_and_collect
+Documentation on billing methods has been moved to
+L<FS::cust_main::Billing>.
-Cancels and suspends any packages due, generates bills, applies payments and
-credits, and applies collection events to run cards, send bills and notices,
-etc.
-
-By default, warns on errors and continues with the next operation (but see the
-"fatal" flag below).
+=item do_cust_event [ HASHREF | OPTION => VALUE ... ]
-Options are passed as name-value pairs. Currently available options are:
+Runs billing events; see L<FS::part_event> and the billing events web
+interface.
-=over 4
+If there is an error, returns the error, otherwise returns false.
-=item time
+Options are passed as name-value pairs.
-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:
+Currently available options are:
- use Date::Parse;
- ...
- $cust_main->bill( 'time' => str2time('April 20th, 2001') );
+=over 4
-=item invoice_time
+=item 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.
+Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions.
=item check_freq
"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
-=item resetup
-
-If set true, re-charges setup fees.
+=item stage
-=item fatal
+"collect" (the default) or "pre-bill"
-If set any errors prevent subsequent operations from continusing. If set
-specifically to "return", returns the error (or false, if there is no error).
-Any other true value causes errors to die.
+=item quiet
+
+set true to surpress email card/ACH decline notices.
=item debug
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
+=cut
-Options are passed to the B<bill> and B<collect> methods verbatim, so all
-options of those methods are also available.
+# =item payby
+#
+# allows for one time override of normal customer billing method
-=cut
+# =item retry
+#
+# Retry card/echeck/LEC transactions even when not scheduled by invoice events.
-sub bill_and_collect {
+sub do_cust_event {
my( $self, %options ) = @_;
+ my $time = $options{'time'} || time;
- my $error;
-
- #$options{actual_time} not $options{time} because freeside-daily -d is for
- #pre-printing invoices
+ #put below somehow?
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
- $options{'actual_time'} ||= time;
- my $job = $options{'job'};
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
- $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";
- if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
- elsif ( $options{fatal} ) { die $error; }
- else { warn $error; }
- }
+ $self->select_for_update; #mutex
- $error = $self->suspend_adjourned_pkgs( $options{actual_time} );
- if ( $error ) {
- $error = "Error adjourning custnum ". $self->custnum. ": $error";
- if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
- elsif ( $options{fatal} ) { die $error; }
- else { warn $error; }
+ if ( $DEBUG ) {
+ my $balance = $self->balance;
+ warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
}
- $job->update_statustext('20,billing packages') if $job;
- $error = $self->bill( %options );
- if ( $error ) {
- $error = "Error billing custnum ". $self->custnum. ": $error";
- if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
- elsif ( $options{fatal} ) { die $error; }
- else { warn $error; }
- }
+# if ( exists($options{'retry_card'}) ) {
+# carp 'retry_card option passed to collect is deprecated; use retry';
+# $options{'retry'} ||= $options{'retry_card'};
+# }
+# if ( exists($options{'retry'}) && $options{'retry'} ) {
+# my $error = $self->retry_realtime;
+# if ( $error ) {
+# $dbh->rollback if $oldAutoCommit;
+# return $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";
- if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
- elsif ( $options{fatal} ) { die $error; }
- else { warn $error; }
- }
+ # false laziness w/pay_batch::import_results
- $job->update_statustext('70,running collection events') if $job;
- unless ( $conf->exists('cancelled_cust-noevents')
- && ! $self->num_ncancelled_pkgs
- ) {
- $error = $self->collect( %options );
- if ( $error ) {
- $error = "Error collecting custnum ". $self->custnum. ": $error";
- if ($options{fatal} && $options{fatal} eq 'return') { return $error; }
- elsif ($options{fatal} ) { die $error; }
- else { warn $error; }
- }
+ my $due_cust_event = $self->due_cust_event(
+ 'debug' => ( $options{'debug'} || 0 ),
+ 'time' => $time,
+ 'check_freq' => $options{'check_freq'},
+ 'stage' => ( $options{'stage'} || 'collect' ),
+ );
+ unless( ref($due_cust_event) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $due_cust_event;
}
- $job->update_statustext('100,finished') if $job;
- '';
-
-}
-
-sub cancel_expired_pkgs {
- my ( $self, $time, %options ) = @_;
-
- my @cancel_pkgs = $self->ncancelled_pkgs( {
- 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
- } );
-
- my @errors = ();
-
- foreach my $cust_pkg ( @cancel_pkgs ) {
- my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
- my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
- 'reason_otaker' => $cpr->otaker
- )
- : ()
- );
- push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
- }
+ $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;
- scalar(@errors) ? join(' / ', @errors) : '';
+ foreach my $cust_event ( @$due_cust_event ) {
-}
+ #XXX lock event
+
+ #re-eval event conditions (a previous event could have changed things)
+ unless ( $cust_event->test_conditions( 'time' => $time ) ) {
+ #don't leave stray "new/locked" records around
+ my $error = $cust_event->delete;
+ return $error if $error;
+ next;
+ }
-sub suspend_adjourned_pkgs {
- my ( $self, $time, %options ) = @_;
+ {
+ local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
+ warn " running cust_event ". $cust_event->eventnum. "\n"
+ if $DEBUG > 1;
- my @susp_pkgs = $self->ncancelled_pkgs( {
- 'extra_sql' =>
- " AND ( susp IS NULL OR susp = 0 )
- AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
- OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
- )
- ",
- } );
+ #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
+ return $error;
+ }
+ }
- #only because there's no SQL test for is_prepaid :/
- @susp_pkgs =
- grep { ( $_->part_pkg->is_prepaid
- && $_->bill
- && $_->bill < $time
- )
- || ( $_->adjourn
- && $_->adjourn <= $time
- )
-
- }
- @susp_pkgs;
-
- my @errors = ();
-
- foreach my $cust_pkg ( @susp_pkgs ) {
- my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
- if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
- my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
- 'reason_otaker' => $cpr->otaker
- )
- : ()
- );
- push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
}
- scalar(@errors) ? join(' / ', @errors) : '';
+ '';
}
-=item bill OPTIONS
+=item due_cust_event [ HASHREF | OPTION => VALUE ... ]
-Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
-conjunction with the collect method by calling B<bill_and_collect>.
+Inserts database records for and returns an ordered listref of new events due
+for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
+events are due, an empty listref is returned. If there is an error, returns a
+scalar error message.
-If there is an error, returns the error, otherwise returns false.
+To actually run the events, call each event's test_condition method, and if
+still true, call the event's do_event method.
-Options are passed as name-value pairs. Currently available options are:
+Options are passed as a hashref or as a list of name-value pairs. Available
+options are:
=over 4
-=item resetup
-
-If set true, re-charges setup fees.
-
-=item time
+=item check_freq
-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:
+Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
- use Date::Parse;
- ...
- $cust_main->bill( 'time' => str2time('April 20th, 2001') );
+=item stage
-=item pkg_list
+"collect" (the default) or "pre-bill"
-An array ref of specific packages (objects) to attempt billing, instead trying all of them.
+=item time
- $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
+"Current time" for the events.
-=item not_pkgpart
+=item debug
-A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
+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 invoice_time
+=item eventtable
-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.
+Only return events for the specified eventtable (by default, events of all eventtables are returned)
-=item cancel
+=item objects
-This boolean value informs the us that the package is being cancelled. This
-typically might mean not charging the normal recurring fee but only usage
-fees since the last billing. Setup charges may be charged. Not all package
-plans support this feature (they tend to charge 0).
+Explicitly pass the objects to be tested (typically used with eventtable).
-=item invoice_terms
+=item testonly
-Optional terms to be printed on this invoice. Otherwise, customer-specific
-terms or the default terms are used.
+Set to true to return the objects, but not actually insert them into the
+database.
=back
=cut
-sub bill {
- my( $self, %options ) = @_;
- return '' if $self->payby eq 'COMP';
- warn "$me bill customer ". $self->custnum. "\n"
- if $DEBUG;
+sub due_cust_event {
+ my $self = shift;
+ my %opt = ref($_[0]) ? %{ $_[0] } : @_;
- my $time = $options{'time'} || time;
- my $invoice_time = $options{'invoice_time'} || $time;
+ #???
+ #my $DEBUG = $opt{'debug'}
+ local($DEBUG) = $opt{'debug'}
+ if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
- $options{'not_pkgpart'} ||= {};
- $options{'not_pkgpart'} = { map { $_ => 1 }
- split(/\s*,\s*/, $options{'not_pkgpart'})
- }
- unless ref($options{'not_pkgpart'});
+ warn "$me due_cust_event called with options ".
+ join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
+ if $DEBUG;
+
+ $opt{'time'} ||= time;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- warn "$me acquiring lock on customer ". $self->custnum. "\n"
- if $DEBUG;
+ $self->select_for_update #mutex
+ unless $opt{testonly};
- $self->select_for_update; #mutex
+ ###
+ # find possible events (initial search)
+ ###
+
+ my @cust_event = ();
- warn "$me running pre-bill events for customer ". $self->custnum. "\n"
- if $DEBUG;
+ my @eventtable = $opt{'eventtable'}
+ ? ( $opt{'eventtable'} )
+ : FS::part_event->eventtables_runorder;
- my $error = $self->do_cust_event(
- 'debug' => ( $options{'debug'} || 0 ),
- 'time' => $invoice_time,
- 'check_freq' => $options{'check_freq'},
- 'stage' => 'pre-bill',
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
+ foreach my $eventtable ( @eventtable ) {
- warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
- if $DEBUG;
+ my @objects;
+ if ( $opt{'objects'} ) {
- #keep auto-charge and non-auto-charge line items separate
- my @passes = ( '', 'no_auto' );
+ @objects = @{ $opt{'objects'} };
- my %cust_bill_pkg = map { $_ => [] } @passes;
+ } else {
- ###
- # find the packages which are due for billing, find out how much they are
- # & generate invoice database.
- ###
+ #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
+ @objects = ( $eventtable eq 'cust_main' )
+ ? ( $self )
+ : ( $self->$eventtable() );
- my %total_setup = map { my $z = 0; $_ => \$z; } @passes;
- my %total_recur = map { my $z = 0; $_ => \$z; } @passes;
+ }
- my %taxlisthash = map { $_ => {} } @passes;
+ my @e_cust_event = ();
- my @precommit_hooks = ();
+ my $cross = "CROSS JOIN $eventtable";
+ $cross .= ' LEFT JOIN cust_main USING ( custnum )'
+ unless $eventtable eq 'cust_main';
- $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks?
- foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
+ foreach my $object ( @objects ) {
- next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
+ #this first search uses the condition_sql magic for optimization.
+ #the more possible events we can eliminate in this step the better
- warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
+ my $cross_where = '';
+ my $pkey = $object->primary_key;
+ $cross_where = "$eventtable.$pkey = ". $object->$pkey();
- #? to avoid use of uninitialized value errors... ?
- $cust_pkg->setfield('bill', '')
- unless defined($cust_pkg->bill);
-
- #my $part_pkg = $cust_pkg->part_pkg;
+ my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
+ my $extra_sql =
+ FS::part_event_condition->where_conditions_sql( $eventtable,
+ 'time'=>$opt{'time'}
+ );
+ my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
- my $real_pkgpart = $cust_pkg->pkgpart;
- my %hash = $cust_pkg->hash;
+ $extra_sql = "AND $extra_sql" if $extra_sql;
- # 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 ) {
+ #here is the agent virtualization
+ $extra_sql .= " AND ( part_event.agentnum IS NULL
+ OR part_event.agentnum = ". $self->agentnum. ' )';
- $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
+ $extra_sql .= " $order";
- my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
+ warn "searching for events for $eventtable ". $object->$pkey. "\n"
+ if $opt{'debug'} > 2;
+ my @part_event = qsearch( {
+ 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
+ 'select' => 'part_event.*',
+ 'table' => 'part_event',
+ 'addl_from' => "$cross $join",
+ 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
+ 'eventtable' => $eventtable,
+ 'disabled' => '',
+ },
+ 'extra_sql' => "AND $cross_where $extra_sql",
+ } );
- my $error =
- $self->_make_lines( 'part_pkg' => $part_pkg,
- 'cust_pkg' => $cust_pkg,
- 'precommit_hooks' => \@precommit_hooks,
- 'line_items' => $cust_bill_pkg{$pass},
- 'setup' => $total_setup{$pass},
- 'recur' => $total_recur{$pass},
- 'tax_matrix' => $taxlisthash{$pass},
- 'time' => $time,
- 'real_pkgpart' => $real_pkgpart,
- 'options' => \%options,
- );
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
+ if ( $DEBUG > 2 ) {
+ my $pkey = $object->primary_key;
+ warn " ". scalar(@part_event).
+ " possible events found for $eventtable ". $object->$pkey(). "\n";
}
- } #foreach my $part_pkg
+ push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
- } #foreach my $cust_pkg
+ }
- #if the customer isn't on an automatic payby, everything can go on a single
- #invoice anyway?
- #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) {
- #merge everything into one list
- #}
+ warn " ". scalar(@e_cust_event).
+ " subtotal possible cust events found for $eventtable\n"
+ if $DEBUG > 1;
- foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
+ push @cust_event, @e_cust_event;
- 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
+ warn " ". scalar(@cust_event).
+ " total possible cust events found in initial search\n"
+ if $DEBUG; # > 1;
- if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
- !$conf->exists('postal_invoice-recurring_only')
- )
- {
- my $postal_pkg = $self->charge_postal_fee();
- if ( $postal_pkg && !ref( $postal_pkg ) ) {
+ ##
+ # test stage
+ ##
- $dbh->rollback if $oldAutoCommit;
- return "can't charge postal invoice fee for customer ".
- $self->custnum. ": $postal_pkg";
-
- } elsif ( $postal_pkg ) {
-
- my $real_pkgpart = $postal_pkg->pkgpart;
- # 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 =
- $self->_make_lines( 'part_pkg' => $part_pkg,
- 'cust_pkg' => $postal_pkg,
- 'precommit_hooks' => \@precommit_hooks,
- 'line_items' => \@cust_bill_pkg,
- 'setup' => $total_setup{$pass},
- 'recur' => $total_recur{$pass},
- 'tax_matrix' => $taxlisthash{$pass},
- 'time' => $time,
- 'real_pkgpart' => $real_pkgpart,
- 'options' => \%postal_options,
- );
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- # it's silly to have a zero value postal_pkg, but....
- @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
-
- }
-
- }
-
- my $listref_or_error =
- $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
+ $opt{stage} ||= 'collect';
+ @cust_event =
+ grep { my $stage = $_->part_event->event_stage;
+ $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
+ }
+ @cust_event;
- unless ( ref( $listref_or_error ) ) {
- $dbh->rollback if $oldAutoCommit;
- return $listref_or_error;
- }
+ ##
+ # test conditions
+ ##
+
+ my %unsat = ();
- foreach my $taxline ( @$listref_or_error ) {
- ${ $total_setup{$pass} } =
- sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
- push @cust_bill_pkg, $taxline;
- }
+ @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
+ 'stats_hashref' => \%unsat ),
+ @cust_event;
- #add tax adjustments
- warn "adding tax adjustments...\n" if $DEBUG > 2;
- foreach my $cust_tax_adjustment (
- qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
- 'billpkgnum' => '',
- }
- )
- ) {
-
- my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
-
- my $itemdesc = $cust_tax_adjustment->taxname;
- $itemdesc = '' if $itemdesc eq 'Tax';
-
- push @cust_bill_pkg, new FS::cust_bill_pkg {
- 'pkgnum' => 0,
- 'setup' => $tax,
- 'recur' => 0,
- 'sdate' => '',
- 'edate' => '',
- 'itemdesc' => $itemdesc,
- 'itemcomment' => $cust_tax_adjustment->comment,
- 'cust_tax_adjustment' => $cust_tax_adjustment,
- #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
- };
+ warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
+ if $DEBUG; # > 1;
- }
+ warn " invalid conditions not eliminated with condition_sql:\n".
+ join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
+ if keys %unsat && $DEBUG; # > 1;
- my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
+ ##
+ # insert
+ ##
- my @cust_bill = $self->cust_bill;
- my $balance = $self->balance;
- my $previous_balance = scalar(@cust_bill)
- ? ( $cust_bill[$#cust_bill]->billing_balance || 0 )
- : 0;
-
- $previous_balance += $cust_bill[$#cust_bill]->charged
- if scalar(@cust_bill);
- #my $balance_adjustments =
- # sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
-
- #create the new invoice
- my $cust_bill = new FS::cust_bill ( {
- 'custnum' => $self->custnum,
- '_date' => ( $invoice_time ),
- 'charged' => $charged,
- 'billing_balance' => $balance,
- 'previous_balance' => $previous_balance,
- 'invoice_terms' => $options{'invoice_terms'},
- } );
- $error = $cust_bill->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't create invoice for customer #". $self->custnum. ": $error";
- }
+ unless( $opt{testonly} ) {
+ foreach my $cust_event ( @cust_event ) {
- foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
- $cust_bill_pkg->invnum($cust_bill->invnum);
- my $error = $cust_bill_pkg->insert;
+ my $error = $cust_event->insert();
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "can't create invoice line item: $error";
- }
- }
-
- } #foreach my $pass ( keys %cust_bill_pkg )
-
- foreach my $hook ( @precommit_hooks ) {
- eval {
- &{$hook}; #($self) ?
- };
- if ( $@ ) {
- $dbh->rollback if $oldAutoCommit;
- return "$@ running precommit hook $hook\n";
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- ''; #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.
-
-Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
-Usually used internally by bill method B<bill>.
-
-If there is an error, returns the error, otherwise returns reference to a
-list of line items suitable for insertion.
-
-=over 4
-
-=item LINEITEMREF
-
-An array ref of the line items being billed.
-
-=item TAXHASHREF
-
-A strange beast. The keys to this hash are internal identifiers consisting
-of the name of the tax object type, a space, and its unique identifier ( e.g.
- 'cust_main_county 23' ). The values of the hash are listrefs. The first
-item in the list is the tax object. The remaining items are either line
-items or floating point values (currency amounts).
-
-The taxes are calculated on this entity. Calculated exemption records are
-transferred to the LINEITEMREF items on the assumption that they are related.
-
-Read the source.
-
-=item INVOICE_TIME
-
-This specifies the date appearing on the associated invoice. Some
-jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
-
-=back
-
-=cut
-sub calculate_taxes {
- my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
-
- my @tax_line_items = ();
-
- warn "having a look at the taxes we found...\n" if $DEBUG > 2;
-
- # keys are tax names (as printed on invoices / itemdesc )
- # values are listrefs of taxlisthash keys (internal identifiers)
- my %taxname = ();
-
- # keys are taxlisthash keys (internal identifiers)
- # values are (cumulative) amounts
- my %tax = ();
-
- # keys are taxlisthash keys (internal identifiers)
- # values are listrefs of cust_bill_pkg_tax_location hashrefs
- my %tax_location = ();
-
- # keys are taxlisthash keys (internal identifiers)
- # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
- my %tax_rate_location = ();
-
- foreach my $tax ( keys %$taxlisthash ) {
- my $tax_object = shift @{ $taxlisthash->{$tax} };
- warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
- warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
- my $hashref_or_error =
- $tax_object->taxline( $taxlisthash->{$tax},
- 'custnum' => $self->custnum,
- 'invoice_time' => $invoice_time
- );
- return $hashref_or_error unless ref($hashref_or_error);
-
- unshift @{ $taxlisthash->{$tax} }, $tax_object;
-
- my $name = $hashref_or_error->{'name'};
- my $amount = $hashref_or_error->{'amount'};
-
- #warn "adding $amount as $name\n";
- $taxname{ $name } ||= [];
- push @{ $taxname{ $name } }, $tax;
-
- $tax{ $tax } += $amount;
-
- $tax_location{ $tax } ||= [];
- if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
- push @{ $tax_location{ $tax } },
- {
- 'taxnum' => $tax_object->taxnum,
- 'taxtype' => ref($tax_object),
- 'pkgnum' => $tax_object->get('pkgnum'),
- 'locationnum' => $tax_object->get('locationnum'),
- 'amount' => sprintf('%.2f', $amount ),
- };
- }
-
- $tax_rate_location{ $tax } ||= [];
- if ( ref($tax_object) eq 'FS::tax_rate' ) {
- my $taxratelocationnum =
- $tax_object->tax_rate_location->taxratelocationnum;
- push @{ $tax_rate_location{ $tax } },
- {
- 'taxnum' => $tax_object->taxnum,
- 'taxtype' => ref($tax_object),
- 'amount' => sprintf('%.2f', $amount ),
- 'locationtaxid' => $tax_object->location,
- 'taxratelocationnum' => $taxratelocationnum,
- };
- }
-
- }
-
- #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
- my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg;
- foreach my $tax ( keys %$taxlisthash ) {
- foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) {
- next unless ref($_) eq 'FS::cust_bill_pkg';
-
- push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
- splice( @{ $_->_cust_tax_exempt_pkg } );
- }
- }
-
- #consolidate and create tax line items
- warn "consolidating and generating...\n" if $DEBUG > 2;
- foreach my $taxname ( keys %taxname ) {
- my $tax = 0;
- my %seen = ();
- my @cust_bill_pkg_tax_location = ();
- my @cust_bill_pkg_tax_rate_location = ();
- warn "adding $taxname\n" if $DEBUG > 1;
- foreach my $taxitem ( @{ $taxname{$taxname} } ) {
- next if $seen{$taxitem}++;
- warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
- $tax += $tax{$taxitem};
- push @cust_bill_pkg_tax_location,
- map { new FS::cust_bill_pkg_tax_location $_ }
- @{ $tax_location{ $taxitem } };
- push @cust_bill_pkg_tax_rate_location,
- map { new FS::cust_bill_pkg_tax_rate_location $_ }
- @{ $tax_rate_location{ $taxitem } };
- }
- next unless $tax;
-
- $tax = sprintf('%.2f', $tax );
-
- my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
- 'disabled' => '',
- },
- );
-
- my @display = ();
- if ( $pkg_category and
- $conf->config('invoice_latexsummary') ||
- $conf->config('invoice_htmlsummary')
- )
- {
-
- my %hash = ( 'section' => $pkg_category->categoryname );
- push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
-
- }
-
- push @tax_line_items, new FS::cust_bill_pkg {
- 'pkgnum' => 0,
- 'setup' => $tax,
- 'recur' => 0,
- 'sdate' => '',
- 'edate' => '',
- 'itemdesc' => $taxname,
- 'display' => \@display,
- 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
- 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
- };
-
- }
-
- \@tax_line_items;
-}
-
-sub _make_lines {
- my ($self, %params) = @_;
-
- my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
- my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
- my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
- my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
- my $total_setup = $params{setup} or die "no setup accumulator specified";
- my $total_recur = $params{recur} or die "no recur accumulator specified";
- my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
- my $time = $params{'time'} or die "no time specified";
- my (%options) = %{$params{options}};
-
- my $dbh = dbh;
- my $real_pkgpart = $params{real_pkgpart};
- my %hash = $cust_pkg->hash;
- my $old_cust_pkg = new FS::cust_pkg \%hash;
-
- my @details = ();
- my @discounts = ();
- my $lineitems = 0;
-
- $cust_pkg->pkgpart($part_pkg->pkgpart);
-
- ###
- # bill setup
- ###
-
- my $setup = 0;
- my $unitsetup = 0;
- if ( $options{'resetup'}
- || ( ! $cust_pkg->setup
- && ( ! $cust_pkg->start_date
- || $cust_pkg->start_date <= $time
- )
- && ( ! $conf->exists('disable_setup_suspended_pkgs')
- || ( $conf->exists('disable_setup_suspended_pkgs') &&
- ! $cust_pkg->getfield('susp')
- )
- )
- )
- )
- {
-
- warn " bill setup\n" if $DEBUG > 1;
- $lineitems++;
-
- $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
- return "$@ running calc_setup for $cust_pkg\n"
- if $@;
-
- $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
-
- $cust_pkg->setfield('setup', $time)
- unless $cust_pkg->setup;
- #do need it, but it won't get written to the db
- #|| $cust_pkg->pkgpart != $real_pkgpart;
-
- $cust_pkg->setfield('start_date', '')
- if $cust_pkg->start_date;
-
- }
-
- ###
- # bill recurring fee
- ###
-
- #XXX unit stuff here too
- my $recur = 0;
- my $unitrecur = 0;
- my $sdate;
- if ( ! $cust_pkg->get('susp')
- and ! $cust_pkg->get('start_date')
- and ( $part_pkg->getfield('freq') ne '0'
- && ( $cust_pkg->getfield('bill') || 0 ) <= $time
- )
- || ( $part_pkg->plan eq 'voip_cdr'
- && $part_pkg->option('bill_every_call')
- )
- || ( $options{cancel} )
- ) {
-
- # XXX should this be a package event? probably. events are called
- # at collection time at the moment, though...
- $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
- if $part_pkg->can('reset_usage');
- #don't want to reset usage just cause we want a line item??
- #&& $part_pkg->pkgpart == $real_pkgpart;
-
- warn " bill recur\n" if $DEBUG > 1;
- $lineitems++;
-
- # XXX shared with $recur_prog
- $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
- || $cust_pkg->setup
- || $time;
-
- #over two params! lets at least switch to a hashref for the rest...
- my $increment_next_bill = ( $part_pkg->freq ne '0'
- && ( $cust_pkg->getfield('bill') || 0 ) <= $time
- && !$options{cancel}
- );
- 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';
- $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
- return "$@ running $method for $cust_pkg\n"
- if ( $@ );
-
- if ( $increment_next_bill ) {
-
- my $next_bill = $part_pkg->add_freq($sdate);
- return "unparsable frequency: ". $part_pkg->freq
- if $next_bill == -1;
-
- #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
- # only for figuring next bill date, nothing else, so, reset $sdate again
- # here
- $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
- #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
- $cust_pkg->last_bill($sdate);
-
- $cust_pkg->setfield('bill', $next_bill );
-
- }
-
- }
-
- warn "\$setup is undefined" unless defined($setup);
- warn "\$recur is undefined" unless defined($recur);
- warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
-
- ###
- # If there's line items, create em cust_bill_pkg records
- # If $cust_pkg has been modified, update it (if we're a real pkgpart)
- ###
-
- 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?
-
- warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
- if $DEBUG >1;
-
- my $error = $cust_pkg->replace( $old_cust_pkg,
- 'options' => { $cust_pkg->options },
- );
- return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
- if $error; #just in case
- }
-
- $setup = sprintf( "%.2f", $setup );
- $recur = sprintf( "%.2f", $recur );
- if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
- return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
- }
- if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
- return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
- }
-
- 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 @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
- if ( $DEBUG > 1 ) {
- warn " adding customer package invoice detail: $_\n"
- foreach @cust_pkg_detail;
- }
- push @details, @cust_pkg_detail;
-
- my $cust_bill_pkg = new FS::cust_bill_pkg {
- 'pkgnum' => $cust_pkg->pkgnum,
- 'setup' => $setup,
- 'unitsetup' => $unitsetup,
- 'recur' => $recur,
- 'unitrecur' => $unitrecur,
- 'quantity' => $cust_pkg->quantity,
- 'details' => \@details,
- 'discounts' => \@discounts,
- 'hidden' => $part_pkg->hidden,
- };
-
- if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
- $cust_bill_pkg->sdate( $hash{last_bill} );
- $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
- $cust_bill_pkg->edate( $time ) if $options{cancel};
- } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
- $cust_bill_pkg->sdate( $sdate );
- $cust_bill_pkg->edate( $cust_pkg->bill );
- #$cust_bill_pkg->edate( $time ) if $options{cancel};
- }
-
- $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
- unless $part_pkg->pkgpart == $real_pkgpart;
-
- $$total_setup += $setup;
- $$total_recur += $recur;
-
- ###
- # handle taxes
- ###
-
- my $error =
- $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
- return $error if $error;
-
- push @$cust_bill_pkgs, $cust_bill_pkg;
-
- } #if $setup != 0 || $recur != 0
-
- } #if $line_items
-
- '';
-
-}
-
-sub _handle_taxes {
- my $self = shift;
- my $part_pkg = shift;
- my $taxlisthash = shift;
- my $cust_bill_pkg = shift;
- my $cust_pkg = shift;
- my $invoice_time = shift;
- my $real_pkgpart = shift;
- my $options = shift;
-
- my %cust_bill_pkg = ();
- my %taxes = ();
-
- my @classes;
- #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
- push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
- push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
- push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
-
- if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
-
- if ( $conf->exists('enable_taxproducts')
- && ( scalar($part_pkg->part_pkg_taxoverride)
- || $part_pkg->has_taxproduct
- )
- )
- {
-
- if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
- return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
- }
-
- foreach my $class (@classes) {
- my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
- return $err_or_ref unless ref($err_or_ref);
- $taxes{$class} = $err_or_ref;
- }
-
- unless (exists $taxes{''}) {
- my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
- return $err_or_ref unless ref($err_or_ref);
- $taxes{''} = $err_or_ref;
- }
-
- } else {
-
- my @loc_keys = qw( city county state country );
- my %taxhash;
- if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
- my $cust_location = $cust_pkg->cust_location;
- %taxhash = map { $_ => $cust_location->$_() } @loc_keys;
- } else {
- my $prefix =
- ( $conf->exists('tax-ship_address') && length($self->ship_last) )
- ? 'ship_'
- : '';
- %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
- }
-
- $taxhash{'taxclass'} = $part_pkg->taxclass;
-
- my @taxes = ();
- my %taxhash_elim = %taxhash;
- my @elim = qw( city county state );
- do {
-
- #first try a match with taxclass
- @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
-
- if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
- #then try a match without taxclass
- my %no_taxclass = %taxhash_elim;
- $no_taxclass{ 'taxclass' } = '';
- @taxes = qsearch( 'cust_main_county', \%no_taxclass );
- }
-
- $taxhash_elim{ shift(@elim) } = '';
-
- } while ( !scalar(@taxes) && scalar(@elim) );
-
- @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
- @taxes
- if $self->cust_main_exemption; #just to be safe
-
- if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
- foreach (@taxes) {
- $_->set('pkgnum', $cust_pkg->pkgnum );
- $_->set('locationnum', $cust_pkg->locationnum );
- }
- }
-
- $taxes{''} = [ @taxes ];
- $taxes{'setup'} = [ @taxes ];
- $taxes{'recur'} = [ @taxes ];
- $taxes{$_} = [ @taxes ] foreach (@classes);
-
- # # maybe eliminate this entirely, along with all the 0% records
- # unless ( @taxes ) {
- # return
- # "fatal: can't find tax rate for state/county/country/taxclass ".
- # join('/', map $taxhash{$_}, qw(state county country taxclass) );
- # }
-
- } #if $conf->exists('enable_taxproducts') ...
-
- }
-
- my @display = ();
- my $separate = $conf->exists('separate_usage');
- 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 %hash = ( 'section' => $section );
-
- $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 };
- } else {
- push @display, new FS::cust_bill_pkg_display
- { type => '',
- %hash,
- ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
- };
- }
-
- if ($separate && $section && $summary) {
- push @display, new FS::cust_bill_pkg_display { type => 'U',
- summary => 'Y',
- %hash,
- };
- }
- if ($usage_mandate || $section && $summary) {
- $hash{post_total} = 'Y';
- }
-
- 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 %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
- foreach my $key (keys %tax_cust_bill_pkg) {
- my @taxes = @{ $taxes{$key} || [] };
- my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
-
- my %localtaxlisthash = ();
- foreach my $tax ( @taxes ) {
-
- my $taxname = ref( $tax ). ' '. $tax->taxnum;
-# $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
-# ' locationnum'. $cust_pkg->locationnum
-# if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
-
- $taxlisthash->{ $taxname } ||= [ $tax ];
- push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
-
- $localtaxlisthash{ $taxname } ||= [ $tax ];
- push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
-
- }
-
- warn "finding taxed taxes...\n" if $DEBUG > 2;
- foreach my $tax ( keys %localtaxlisthash ) {
- my $tax_object = shift @{ $localtaxlisthash{$tax} };
- warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
- if $DEBUG > 2;
- next unless $tax_object->can('tax_on_tax');
-
- foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
- my $totname = ref( $tot ). ' '. $tot->taxnum;
-
- warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
- if $DEBUG > 2;
- next unless exists( $localtaxlisthash{ $totname } ); # only increase
- # existing taxes
- warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
- my $hashref_or_error =
- $tax_object->taxline( $localtaxlisthash{$tax},
- 'custnum' => $self->custnum,
- 'invoice_time' => $invoice_time,
- );
- return $hashref_or_error
- unless ref($hashref_or_error);
-
- $taxlisthash->{ $totname } ||= [ $tot ];
- push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
-
+ return $error;
}
+
}
-
}
- '';
-}
-
-sub _gather_taxes {
- my $self = shift;
- my $part_pkg = shift;
- my $class = shift;
-
- my @taxes = ();
- my $geocode = $self->geocode('cch');
-
- my @taxclassnums = map { $_->taxclassnum }
- $part_pkg->part_pkg_taxoverride($class);
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- unless (@taxclassnums) {
- @taxclassnums = map { $_->taxclassnum }
- grep { $_->taxable eq 'Y' }
- $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
- }
- warn "Found taxclassnum values of ". join(',', @taxclassnums)
- if $DEBUG;
-
- my $extra_sql =
- "AND (".
- join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
-
- @taxes = qsearch({ 'table' => 'tax_rate',
- 'hashref' => { 'geocode' => $geocode, },
- 'extra_sql' => $extra_sql,
- })
- if scalar(@taxclassnums);
-
- warn "Found taxes ".
- join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
- if $DEBUG;
-
- [ @taxes ];
-
-}
-
-=item collect [ HASHREF | OPTION => VALUE ... ]
-
-(Attempt to) collect money for this customer's outstanding invoices (see
-L<FS::cust_bill>). Usually used after the bill method.
-
-Actions are now triggered by billing events; see L<FS::part_event> and the
-billing events web interface. Old-style invoice events (see
-L<FS::part_bill_event>) have been deprecated.
-
-If there is an error, returns the error, otherwise returns false.
-
-Options are passed as name-value pairs.
-
-Currently available options are:
-
-=over 4
-
-=item invoice_time
-
-Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item retry
-
-Retry card/echeck/LEC transactions even when not scheduled by invoice events.
-
-=item check_freq
-
-"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
-
-=item quiet
-
-set true to surpress email card/ACH decline notices.
-
-=item debug
-
-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)
-
-=back
-
-# =item payby
-#
-# allows for one time override of normal customer billing method
-
-=cut
-
-sub collect {
- my( $self, %options ) = @_;
- my $invoice_time = $options{'invoice_time'} || time;
-
- #put below somehow?
- 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
-
- if ( $DEBUG ) {
- my $balance = $self->balance;
- warn "$me collect customer ". $self->custnum. ": balance $balance\n"
- }
-
- if ( exists($options{'retry_card'}) ) {
- carp 'retry_card option passed to collect is deprecated; use retry';
- $options{'retry'} ||= $options{'retry_card'};
- }
- if ( exists($options{'retry'}) && $options{'retry'} ) {
- my $error = $self->retry_realtime;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $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',
- );
-
-}
-
-=item do_cust_event [ HASHREF | OPTION => VALUE ... ]
-
-Runs billing events; see L<FS::part_event> and the billing events web
-interface.
-
-If there is an error, returns the error, otherwise returns false.
-
-Options are passed as name-value pairs.
-
-Currently available options are:
-
-=over 4
-
-=item time
-
-Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item check_freq
-
-"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
-
-=item stage
-
-"collect" (the default) or "pre-bill"
-
-=item quiet
-
-set true to surpress email card/ACH decline notices.
-
-=item debug
-
-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)
-
-=cut
-
-# =item payby
-#
-# allows for one time override of normal customer billing method
-
-# =item retry
-#
-# Retry card/echeck/LEC transactions even when not scheduled by invoice events.
-
-sub do_cust_event {
- my( $self, %options ) = @_;
- my $time = $options{'time'} || time;
-
- #put below somehow?
- 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
-
- if ( $DEBUG ) {
- my $balance = $self->balance;
- warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
- }
-
-# if ( exists($options{'retry_card'}) ) {
-# carp 'retry_card option passed to collect is deprecated; use retry';
-# $options{'retry'} ||= $options{'retry_card'};
-# }
-# if ( exists($options{'retry'}) && $options{'retry'} ) {
-# my $error = $self->retry_realtime;
-# if ( $error ) {
-# $dbh->rollback if $oldAutoCommit;
-# return $error;
-# }
-# }
-
- # false laziness w/pay_batch::import_results
-
- my $due_cust_event = $self->due_cust_event(
- 'debug' => ( $options{'debug'} || 0 ),
- 'time' => $time,
- 'check_freq' => $options{'check_freq'},
- 'stage' => ( $options{'stage'} || 'collect' ),
- );
- unless( ref($due_cust_event) ) {
- $dbh->rollback 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
-
- #re-eval event conditions (a previous event could have changed things)
- unless ( $cust_event->test_conditions( 'time' => $time ) ) {
- #don't leave stray "new/locked" records around
- my $error = $cust_event->delete;
- return $error if $error;
- next;
- }
-
- {
- local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
- 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
- return $error;
- }
- }
-
- }
-
- '';
-
-}
-
-=item due_cust_event [ HASHREF | OPTION => VALUE ... ]
-
-Inserts database records for and returns an ordered listref of new events due
-for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
-events are due, an empty listref is returned. If there is an error, returns a
-scalar error message.
-
-To actually run the events, call each event's test_condition method, and if
-still true, call the event's do_event method.
-
-Options are passed as a hashref or as a list of name-value pairs. Available
-options are:
-
-=over 4
-
-=item check_freq
-
-Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
-
-=item stage
-
-"collect" (the default) or "pre-bill"
-
-=item time
-
-"Current time" for the events.
-
-=item debug
-
-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 eventtable
-
-Only return events for the specified eventtable (by default, events of all eventtables are returned)
-
-=item objects
-
-Explicitly pass the objects to be tested (typically used with eventtable).
-
-=item testonly
-
-Set to true to return the objects, but not actually insert them into the
-database.
-
-=back
-
-=cut
-
-sub due_cust_event {
- my $self = shift;
- my %opt = ref($_[0]) ? %{ $_[0] } : @_;
-
- #???
- #my $DEBUG = $opt{'debug'}
- local($DEBUG) = $opt{'debug'}
- if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
-
- warn "$me due_cust_event called with options ".
- join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
- if $DEBUG;
-
- $opt{'time'} ||= time;
-
- 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 $opt{testonly};
-
- ###
- # find possible events (initial search)
- ###
-
- my @cust_event = ();
-
- my @eventtable = $opt{'eventtable'}
- ? ( $opt{'eventtable'} )
- : FS::part_event->eventtables_runorder;
-
- foreach my $eventtable ( @eventtable ) {
-
- my @objects;
- if ( $opt{'objects'} ) {
-
- @objects = @{ $opt{'objects'} };
-
- } else {
-
- #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
- @objects = ( $eventtable eq 'cust_main' )
- ? ( $self )
- : ( $self->$eventtable() );
-
- }
-
- my @e_cust_event = ();
-
- my $cross = "CROSS JOIN $eventtable";
- $cross .= ' LEFT JOIN cust_main USING ( custnum )'
- unless $eventtable eq 'cust_main';
-
- foreach my $object ( @objects ) {
-
- #this first search uses the condition_sql magic for optimization.
- #the more possible events we can eliminate in this step the better
-
- my $cross_where = '';
- my $pkey = $object->primary_key;
- $cross_where = "$eventtable.$pkey = ". $object->$pkey();
-
- my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
- my $extra_sql =
- FS::part_event_condition->where_conditions_sql( $eventtable,
- 'time'=>$opt{'time'}
- );
- my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
-
- $extra_sql = "AND $extra_sql" if $extra_sql;
-
- #here is the agent virtualization
- $extra_sql .= " AND ( part_event.agentnum IS NULL
- OR part_event.agentnum = ". $self->agentnum. ' )';
-
- $extra_sql .= " $order";
-
- warn "searching for events for $eventtable ". $object->$pkey. "\n"
- if $opt{'debug'} > 2;
- my @part_event = qsearch( {
- 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
- 'select' => 'part_event.*',
- 'table' => 'part_event',
- 'addl_from' => "$cross $join",
- 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
- 'eventtable' => $eventtable,
- 'disabled' => '',
- },
- 'extra_sql' => "AND $cross_where $extra_sql",
- } );
-
- if ( $DEBUG > 2 ) {
- my $pkey = $object->primary_key;
- warn " ". scalar(@part_event).
- " possible events found for $eventtable ". $object->$pkey(). "\n";
- }
-
- push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
-
- }
-
- warn " ". scalar(@e_cust_event).
- " subtotal possible cust events found for $eventtable\n"
- if $DEBUG > 1;
-
- push @cust_event, @e_cust_event;
-
- }
-
- warn " ". scalar(@cust_event).
- " total possible cust events found in initial search\n"
- if $DEBUG; # > 1;
-
-
- ##
- # test stage
- ##
-
- $opt{stage} ||= 'collect';
- @cust_event =
- grep { my $stage = $_->part_event->event_stage;
- $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
- }
- @cust_event;
-
- ##
- # test conditions
- ##
-
- my %unsat = ();
-
- @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
- 'stats_hashref' => \%unsat ),
- @cust_event;
-
- warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
- if $DEBUG; # > 1;
-
- warn " invalid conditions not eliminated with condition_sql:\n".
- join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
- if keys %unsat && $DEBUG; # > 1;
-
- ##
- # insert
- ##
-
- unless( $opt{testonly} ) {
- foreach my $cust_event ( @cust_event ) {
-
- my $error = $cust_event->insert();
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- ##
- # return
- ##
-
- warn " returning events: ". Dumper(@cust_event). "\n"
- if $DEBUG > 2;
-
- \@cust_event;
-
-}
-
-=item retry_realtime
-
-Schedules realtime / batch credit card / electronic check / LEC billing
-events for for retry. Useful if card information has changed or manual
-retry is desired. The 'collect' method must be called to actually retry
-the transaction.
-
-Implementation details: For either this customer, or for each of this
-customer's open invoices, changes the status of the first "done" (with
-statustext error) realtime processing event to "failed".
-
-=cut
-
-sub retry_realtime {
- 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;
-
- #a little false laziness w/due_cust_event (not too bad, really)
-
- my $join = FS::part_event_condition->join_conditions_sql;
- my $order = FS::part_event_condition->order_conditions_sql;
- my $mine =
- '( '
- . join ( ' OR ' , map {
- "( part_event.eventtable = " . dbh->quote($_)
- . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
- } FS::part_event->eventtables)
- . ') ';
-
- #here is the agent virtualization
- my $agent_virt = " ( part_event.agentnum IS NULL
- OR part_event.agentnum = ". $self->agentnum. ' )';
-
- #XXX this shouldn't be hardcoded, actions should declare it...
- my @realtime_events = qw(
- cust_bill_realtime_card
- cust_bill_realtime_check
- cust_bill_realtime_lec
- cust_bill_batch
- );
-
- my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
- @realtime_events
- ).
- ' ) ';
-
- my @cust_event = qsearchs({
- 'table' => 'cust_event',
- 'select' => 'cust_event.*',
- 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
- 'hashref' => { 'status' => 'done' },
- 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
- " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
- });
-
- my %seen_invnum = ();
- foreach my $cust_event (@cust_event) {
-
- #max one for the customer, one for each open invoice
- my $cust_X = $cust_event->cust_X;
- next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
- ? $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;
- '';
-
-}
-
-
-=cut
-
-=item realtime_collect [ OPTION => VALUE ... ]
-
-Runs a realtime credit card, ACH (electronic check) or phone bill transaction
-via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
-gateway. See L<http://420.am/business-onlinepayment> and
-L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
-
-On failure returns an error message.
-
-Returns false or a hashref upon success. The hashref contains keys popup_url reference, and collectitems. The first is a URL to which a browser should be redirected for completion of collection. The second is a reference id for the transaction suitable for the end user. The collectitems is a reference to a list of name value pairs suitable for assigning to a html form and posted to popup_url.
-
-Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>, I<pkgnum>
-
-I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified
-then it is deduced from the customer record.
-
-If no I<amount> is specified, then the customer balance is used.
-
-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.
-
-I<session_id> is a session identifier associated with this payment.
-
-I<depend_jobnum> allows payment capture to unlock export jobs
-
-=cut
-
-sub realtime_collect {
- my( $self, %options ) = @_;
-
- if ( $DEBUG ) {
- warn "$me realtime_collect:\n";
- warn " $_ => $options{$_}\n" foreach keys %options;
- }
-
- $options{amount} = $self->balance unless exists( $options{amount} );
- $options{method} = FS::payby->payby2bop($self->payby)
- unless exists( $options{method} );
-
- return $self->realtime_bop({%options});
-
-}
-
-=item realtime_bop { [ ARG => 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.
-
-Required arguments in the hashref are I<method>, and I<amount>
-
-Available methods are: I<CC>, I<ECHECK> and I<LEC>
-
-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 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.
-
-I<session_id> is a session identifier associated with this payment.
-
-I<depend_jobnum> allows payment capture to unlock export jobs
-
-(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
-
-=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} = $self->agent->payment_gateway( %$options )
- unless exists($options->{payment_gateway});
-
- $options->{payment_gateway};
-}
-
-sub _bop_auth {
- my ($self, $options) = @_;
-
- (
- 'login' => $options->{payment_gateway}->gateway_username,
- 'password' => $options->{payment_gateway}->gateway_password,
- );
-}
-
-sub _bop_options {
- my ($self, $options) = @_;
-
- $options->{payment_gateway}->gatewaynum
- ? $options->{payment_gateway}->options
- : @{ $options->{payment_gateway}->get('options') };
-
-}
-
-sub _bop_defaults {
- my ($self, $options) = @_;
-
- 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';
- }
- }
-
- $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
- $options->{invnum} ||= '';
- $options->{payname} = $self->payname unless exists( $options->{payname} );
-}
-
-sub _bop_content {
- my ($self, $options) = @_;
- 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 ($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{name} = $payname;
-
- $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}
- : $self->city;
- $content{state} = exists($options->{state})
- ? $options->{state}
- : $self->state;
- $content{zip} = exists($options->{zip})
- ? $options->{'zip'}
- : $self->zip;
- $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;
-}
-
-my %bop_method2payby = (
- 'CC' => 'CARD',
- 'ECHECK' => 'CHEK',
- 'LEC' => 'LECB',
-);
-
-sub realtime_bop {
- my $self = shift;
-
- my %options = ();
- if (ref($_[0]) eq 'HASH') {
- %options = %{$_[0]};
- } else {
- my ( $method, $amount ) = ( shift, shift );
- %options = @_;
- $options{method} = $method;
- $options{amount} = $amount;
- }
-
- if ( $DEBUG ) {
- warn "$me realtime_bop (new): $options{method} $options{amount}\n";
- warn " $_ => $options{$_}\n" foreach keys %options;
- }
-
- return $self->fake_bop(%options) if $options{'fake'};
-
- $self->_bop_defaults(\%options);
-
- ###
- # set trans_is_recur based on invnum if there is one
- ###
-
- 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;
-
- $trans_is_recur = 1
- if grep { $_->freq ne '0' } @part_pkg;
-
- }
-
- ###
- # select a gateway
- ###
-
- my $payment_gateway = $self->_payment_gateway( \%options );
- my $namespace = $payment_gateway->gateway_namespace;
-
- eval "use $namespace";
- die $@ if $@;
-
- ###
- # check for banned credit card/ACH
- ###
-
- my $ban = qsearchs('banned_pay', {
- 'payby' => $bop_method2payby{$options{method}},
- 'payinfo' => md5_base64($options{payinfo}),
- } );
- return "Banned credit card" if $ban;
-
- ###
- # massage data
- ###
-
- 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')
- || $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 $paydate = '';
- my %content = ();
- if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
-
- $content{card_number} = $options{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' => $options{'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 ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
- ( $content{account_number}, $content{routing_code} ) =
- split('@', $options{payinfo});
- $content{bank_name} = $options{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} = $self->getfield('first'). ' '.
- $self->getfield('last');
-
- $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 ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
- $content{phone} = $options{payinfo};
- } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
- #move along
- } else {
- #die an evil death
- }
-
- ###
- # 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; $options{method} transaction aborted."
- if $self->balance < $balance;
- #&& $self->balance < $options{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 ).
- "); $options{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' => $options{amount},
- '_date' => '',
- 'payby' => $bop_method2payby{$options{method}},
- 'payinfo' => $options{payinfo},
- 'paydate' => $paydate,
- 'recurring_billing' => $content{recurring_billing},
- 'pkgnum' => $options{'pkgnum'},
- 'status' => 'new',
- 'gatewaynum' => $payment_gateway->gatewaynum || '',
- 'session_id' => $options{session_id} || '',
- 'jobnum' => $options{depend_jobnum} || '',
- };
- $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*/, $payment_gateway->gateway_action );
-
- my $transaction = new $namespace( $payment_gateway->gateway_module,
- $self->_bop_options(\%options),
- );
-
- $transaction->content(
- 'type' => $options{method},
- $self->_bop_auth(\%options),
- 'action' => $action1,
- 'description' => $options{'description'},
- 'amount' => $options{amount},
- #'invoice_number' => $options{'invnum'},
- 'customer_id' => $self->custnum,
- %$bop_content,
- 'reference' => $cust_pay_pending->paypendingnum, #for now
- 'email' => $email,
- %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->test_transaction(1)
- if $conf->exists('business-onlinepayment-test_transaction');
- $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() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
-
- return { reference => $cust_pay_pending->paypendingnum,
- map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
-
- } elsif ( $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( $payment_gateway->gateway_module,
- $self->_bop_options(\%options),
- );
-
- my %capture = (
- %content,
- type => $options{method},
- action => $action2,
- $self->_bop_auth(\%options),
- order_number => $ordernum,
- amount => $options{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->test_transaction(1)
- if $conf->exists('business-onlinepayment-test_transaction');
- $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;
- }
-
- }
-
- ###
- # remove paycvv after initial transaction
- ###
-
- #false laziness w/misc/process/payment.cgi - check both to make sure working
- # correctly
- if ( length($self->paycvv)
- && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
- ) {
- my $error = $self->remove_cvv;
- if ( $error ) {
- warn "WARNING: error removing cvv: $error\n";
- }
- }
-
- ###
- # 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
- ###
-
- $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
-
-}
-
-=item fake_bop
-
-=cut
-
-sub fake_bop {
- my $self = shift;
-
- my %options = ();
- if (ref($_[0]) eq 'HASH') {
- %options = %{$_[0]};
- } else {
- my ( $method, $amount ) = ( shift, shift );
- %options = @_;
- $options{method} = $method;
- $options{amount} = $amount;
- }
-
- if ( $options{'fake_failure'} ) {
- return "Error: No error; test failure requested with fake_failure";
- }
-
- #my $paybatch = '';
- #if ( $payment_gateway->gatewaynum ) { # agent override
- # $paybatch = $payment_gateway->gatewaynum. '-';
- #}
- #
- #$paybatch .= "$processor:". $transaction->authorization;
- #
- #$paybatch .= ':'. $transaction->order_number
- # if $transaction->can('order_number')
- # && length($transaction->order_number);
-
- my $paybatch = 'FakeProcessor:54:32';
-
- my $cust_pay = new FS::cust_pay ( {
- 'custnum' => $self->custnum,
- 'invnum' => $options{'invnum'},
- 'paid' => $options{amount},
- '_date' => '',
- 'payby' => $bop_method2payby{$options{method}},
- #'payinfo' => $payinfo,
- 'payinfo' => '4111111111111111',
- 'paybatch' => $paybatch,
- #'paydate' => $paydate,
- 'paydate' => '2012-05-01',
- } );
- $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
-
- 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, even with transactions.
- my $e = 'WARNING: Card/ACH debited but database not updated - '.
- "error inserting (fake!) payment: $error2".
- " (previously tried insert with invnum #$options{'invnum'}" .
- ": $error )";
- warn $e;
- return $e;
- }
- }
-
- if ( $options{'paynum_ref'} ) {
- ${ $options{'paynum_ref'} } = $cust_pay->paynum;
- }
-
- return ''; #no error
-
-}
-
-
-# item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
-#
-# Wraps up processing of a realtime credit card, ACH (electronic check) or
-# phone bill transaction.
-
-sub _realtime_bop_result {
- my( $self, $cust_pay_pending, $transaction, %options ) = @_;
- if ( $DEBUG ) {
- warn "$me _realtime_bop_result: pending transaction ".
- $cust_pay_pending->paypendingnum. "\n";
- warn " $_ => $options{$_}\n" foreach keys %options;
- }
-
- my $payment_gateway = $options{payment_gateway}
- or return "no payment gateway in arguments to _realtime_bop_result";
-
- $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;
-
- if ( $transaction->is_success() ) {
-
- my $paybatch = '';
- if ( $payment_gateway->gatewaynum ) { # agent override
- $paybatch = $payment_gateway->gatewaynum. '-';
- }
-
- $paybatch .= $payment_gateway->gateway_module. ":".
- $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' => $cust_pay_pending->paid,
- '_date' => '',
- 'payby' => $cust_pay_pending->payby,
- 'payinfo' => $options{'payinfo'},
- 'paybatch' => $paybatch,
- 'paydate' => $cust_pay_pending->paydate,
- 'pkgnum' => $cust_pay_pending->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: $options{method} captured but payment not recorded -".
- " error inserting payment (". $payment_gateway->gateway_module.
- "): $error2".
- " (previously tried insert with invnum #$options{'invnum'}" .
- ": $error ) - pending payment saved as paypendingnum ".
- $cust_pay_pending->paypendingnum. "\n";
- warn $e;
- return $e;
- }
- }
-
- my $jobnum = $cust_pay_pending->jobnum;
- if ( $jobnum ) {
- my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
-
- unless ( $placeholder ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- my $e = "WARNING: $options{method} captured but job $jobnum not ".
- "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
- warn $e;
- return $e;
- }
-
- $error = $placeholder->delete;
-
- if ( $error ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- my $e = "WARNING: $options{method} captured but could not delete ".
- "job $jobnum for paypendingnum ".
- $cust_pay_pending->paypendingnum. ": $error\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: $options{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 = $payment_gateway->gateway_module. " error: ".
- $transaction->error_message;
-
- my $jobnum = $cust_pay_pending->jobnum;
- if ( $jobnum ) {
- my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
-
- if ( $placeholder ) {
- my $error = $placeholder->depended_delete;
- $error ||= $placeholder->delete;
- warn "error removing provisioning jobs after declined paypendingnum ".
- $cust_pay_pending->paypendingnum. "\n";
- } else {
- my $e = "error finding job $jobnum for declined paypendingnum ".
- $cust_pay_pending->paypendingnum. "\n";
- warn $e;
- }
-
- }
-
- 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 ".
- $payment_gateway->gateway_module;
- }
-
- $perror .= "No error_message returned from ".
- $payment_gateway->gateway_module. " -- ".
- ( 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')
- ) {
-
- # 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;
-
- }
-
- $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: $options{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;
- }
-
-}
-
-=item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
-
-Verifies successful third party processing of a realtime credit card,
-ACH (electronic check) or phone bill transaction via a
-Business::OnlineThirdPartyPayment realtime gateway. See
-L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
-
-Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
-
-The additional options I<payname>, I<city>, I<state>,
-I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
-if set, will override the value from the customer record.
-
-I<description> is a free-text field passed to the gateway. It defaults to
-"Internet services".
-
-If an I<invnum> is specified, this payment (if 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.
-
-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.
-
-Returns a hashref containing elements bill_error (which will be undefined
-upon success) and session_id of any associated session.
-
-=cut
-
-sub realtime_botpp_capture {
- my( $self, $cust_pay_pending, %options ) = @_;
- if ( $DEBUG ) {
- warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
- warn " $_ => $options{$_}\n" foreach keys %options;
- }
-
- eval "use Business::OnlineThirdPartyPayment";
- die $@ if $@;
-
- ###
- # select the gateway
- ###
-
- my $method = FS::payby->payby2bop($cust_pay_pending->payby);
-
- my $payment_gateway = $cust_pay_pending->gatewaynum
- ? qsearchs( 'payment_gateway',
- { gatewaynum => $cust_pay_pending->gatewaynum }
- )
- : $self->agent->payment_gateway( 'method' => $method,
- # 'invnum' => $cust_pay_pending->invnum,
- # 'payinfo' => $cust_pay_pending->payinfo,
- );
-
- $options{payment_gateway} = $payment_gateway; # for the helper subs
-
- ###
- # massage data
- ###
-
- 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 = ();
-
- $content{email_customer} =
- ( $conf->exists('business-onlinepayment-email_customer')
- || $conf->exists('business-onlinepayment-email-override') );
-
- ###
- # run transaction(s)
- ###
-
- my $transaction =
- new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
- $self->_bop_options(\%options),
- );
-
- $transaction->reference({ %options });
-
- $transaction->content(
- 'type' => $method,
- $self->_bop_auth(\%options),
- 'action' => 'Post Authorization',
- 'description' => $options{'description'},
- 'amount' => $cust_pay_pending->paid,
- #'invoice_number' => $options{'invnum'},
- 'customer_id' => $self->custnum,
- 'referer' => 'http://cleanwhisker.420.am/',
- 'reference' => $cust_pay_pending->paypendingnum,
- 'email' => $email,
- 'phone' => $self->daytime || $self->night,
- %content, #after
- # plus whatever is required for bogus capture avoidance
- );
-
- $transaction->submit();
-
- my $error =
- $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
-
- {
- bill_error => $error,
- session_id => $cust_pay_pending->session_id,
- }
-
-}
-
-=item default_payment_gateway DEPRECATED -- use agent->payment_gateway
-
-=cut
-
-sub default_payment_gateway {
- my( $self, $method ) = @_;
-
- die "Real-time processing not enabled\n"
- unless $conf->exists('business-onlinepayment');
-
- #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
-
- #load up config
- my $bop_config = 'business-onlinepayment';
- $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';
- pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
- die "No real-time processor is enabled - ".
- "did you set the business-onlinepayment configuration value?\n"
- unless $processor;
-
- ( $processor, $login, $password, $action, @bop_options )
-}
-
-=item remove_cvv
-
-Removes the I<paycvv> field from the database directly.
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub remove_cvv {
- my $self = shift;
- my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
- or return dbh->errstr;
- $sth->execute($self->custnum)
- or return $sth->errstr;
- $self->paycvv('');
- '';
-}
-
-=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;
-
- my %options = ();
- if (ref($_[0]) eq 'HASH') {
- %options = %{$_[0]};
- } else {
- my $method = shift;
- %options = @_;
- $options{method} = $method;
- }
-
- if ( $DEBUG ) {
- warn "$me realtime_refund_bop (new): $options{method} refund\n";
- warn " $_ => $options{$_}\n" foreach keys %options;
- }
-
- ###
- # look up the original payment and optionally a gateway for that payment
- ###
-
- my $cust_pay = '';
- my $amount = $options{'amount'};
+ ##
+ # return
+ ##
- my( $processor, $login, $password, @bop_options, $namespace ) ;
- my( $auth, $order_number ) = ( '', '', '' );
+ warn " returning events: ". Dumper(@cust_event). "\n"
+ if $DEBUG > 2;
- if ( $options{'paynum'} ) {
+ \@cust_event;
- 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 );
+=item retry_realtime
- if ( $gatewaynum ) { #gateway for the payment to be refunded
+Schedules realtime / batch credit card / electronic check / LEC billing
+events for for retry. Useful if card information has changed or manual
+retry is desired. The 'collect' method must be called to actually retry
+the transaction.
- my $payment_gateway =
- qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
- die "payment gateway $gatewaynum not found"
- unless $payment_gateway;
+Implementation details: For either this customer, or for each of this
+customer's open invoices, changes the status of the first "done" (with
+statustext error) realtime processing event to "failed".
- $processor = $payment_gateway->gateway_module;
- $login = $payment_gateway->gateway_username;
- $password = $payment_gateway->gateway_password;
- $namespace = $payment_gateway->gateway_namespace;
- @bop_options = $payment_gateway->options;
+=cut
- } else { #try the default gateway
+sub retry_realtime {
+ my $self = shift;
- my $conf_processor;
- my $payment_gateway =
- $self->agent->payment_gateway('method' => $options{method});
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
- ( $conf_processor, $login, $password, $namespace ) =
- map { my $method = "gateway_$_"; $payment_gateway->$method }
- qw( module username password namespace );
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
- @bop_options = $payment_gateway->gatewaynum
- ? $payment_gateway->options
- : @{ $payment_gateway->get('options') };
+ #a little false laziness w/due_cust_event (not too bad, really)
- return "processor of payment $options{'paynum'} $processor does not".
- " match default processor $conf_processor"
- unless $processor eq $conf_processor;
+ my $join = FS::part_event_condition->join_conditions_sql;
+ my $order = FS::part_event_condition->order_conditions_sql;
+ my $mine =
+ '( '
+ . join ( ' OR ' , map {
+ "( part_event.eventtable = " . dbh->quote($_)
+ . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
+ } FS::part_event->eventtables)
+ . ') ';
- }
+ #here is the agent virtualization
+ my $agent_virt = " ( part_event.agentnum IS NULL
+ OR part_event.agentnum = ". $self->agentnum. ' )';
+ #XXX this shouldn't be hardcoded, actions should declare it...
+ my @realtime_events = qw(
+ cust_bill_realtime_card
+ cust_bill_realtime_check
+ cust_bill_realtime_lec
+ cust_bill_batch
+ );
- } else { # didn't specify a paynum, so look for agent gateway overrides
- # like a normal transaction
-
- my $payment_gateway =
- $self->agent->payment_gateway( 'method' => $options{method},
- #'payinfo' => $payinfo,
- );
- my( $processor, $login, $password, $namespace ) =
- map { my $method = "gateway_$_"; $payment_gateway->$method }
- qw( module username password namespace );
-
- my @bop_options = $payment_gateway->gatewaynum
- ? $payment_gateway->options
- : @{ $payment_gateway->get('options') };
+ my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
+ @realtime_events
+ ).
+ ' ) ';
- }
- return "neither amount nor paynum specified" unless $amount;
+ my @cust_event = qsearchs({
+ 'table' => 'cust_event',
+ 'select' => 'cust_event.*',
+ 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
+ 'hashref' => { 'status' => 'done' },
+ 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
+ " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
+ });
- eval "use $namespace";
- die $@ if $@;
+ my %seen_invnum = ();
+ foreach my $cust_event (@cust_event) {
- my %content = (
- 'type' => $options{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;
- }
+ #max one for the customer, one for each open invoice
+ my $cust_X = $cust_event->cust_X;
+ next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
+ ? $cust_X->invnum
+ : 0
+ }++
+ or $cust_event->part_event->eventtable eq 'cust_bill'
+ && ! $cust_X->owed;
- #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->test_transaction(1)
- if $conf->exists('business-onlinepayment-test_transaction');
- $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 '';
+ my $error = $cust_event->retry;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error scheduling event for retry: $error";
}
- }
-
- 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 && $options{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;
- }
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
- 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 ( $options{method} eq 'CC' ) {
+=cut
- 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";
- }
+=item REALTIME BILLING METHODS
- } elsif ( $options{method} eq 'ECHECK' ) {
+Documentation on realtime billing methods has been moved to
+L<FS::cust_main::Billing_Realtime>.
- 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 ( $options{method} eq 'LEC' ) {
- $content{phone} = $payinfo = $self->payinfo;
- }
+=item remove_cvv
- #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->test_transaction(1)
- if $conf->exists('business-onlinepayment-test_transaction');
- $refund->submit();
-
- return "$processor error: ". $refund->error_message
- unless $refund->is_success();
-
- 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;
- }
+Removes the I<paycvv> field from the database directly.
- my $cust_refund = new FS::cust_refund ( {
- 'custnum' => $self->custnum,
- 'paynum' => $options{'paynum'},
- 'refund' => $amount,
- '_date' => '',
- 'payby' => $bop_method2payby{$options{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;
- }
- }
+If there is an error, returns the error, otherwise returns false.
- ''; #no error
+=cut
+sub remove_cvv {
+ my $self = shift;
+ my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
+ or return dbh->errstr;
+ $sth->execute($self->custnum)
+ or return $sth->errstr;
+ $self->paycvv('');
+ '';
}
=item batch_card OPTION => VALUE...
'';
}
-=item apply_payments_and_credits [ OPTION => VALUE ... ]
-
-Applies unapplied payments and credits.
-
-In most cases, this new method should be used in place of sequential
-apply_payments and apply_credits methods.
-
-A hash of optional arguments may be passed. Currently "manual" is supported.
-If true, a payment receipt is sent instead of a statement when
-'payment_receipt_email' configuration option is set.
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub apply_payments_and_credits {
- my( $self, %options ) = @_;
-
- 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 ) {
- my $error = $cust_bill->apply_payments_and_credits(%options);
- 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 ...
-
-Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
-to outstanding invoice balances in chronological order (or reverse
-chronological order if the I<order> option is set to B<newest>) and returns the
-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 = @_;
-
- 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_unapplied_credits ) {
- $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 } ) );
-
- my @invoices = $self->open_cust_bill;
- @invoices = sort { $b->_date <=> $a->_date } @invoices
- if defined($opt{'order'}) && $opt{'order'} eq 'newest';
-
- if ( $conf->exists('pkg-balances') ) {
- # limit @credits to those w/ a pkgnum grepped from $self
- my %pkgnums = ();
- foreach my $i (@invoices) {
- foreach my $li ( $i->cust_bill_pkg ) {
- $pkgnums{$li->pkgnum} = 1;
- }
- }
- @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
- }
-
- my $credit;
-
- foreach my $cust_bill ( @invoices ) {
-
- if ( !defined($credit) || $credit->credited == 0) {
- $credit = pop @credits or last;
- }
-
- my $owed;
- if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
- $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
- } else {
- $owed = $cust_bill->owed;
- }
- unless ( $owed > 0 ) {
- push @credits, $credit;
- next;
- }
-
- my $amount = min( $credit->credited, $owed );
-
- my $cust_credit_bill = new FS::cust_credit_bill ( {
- 'crednum' => $credit->crednum,
- 'invnum' => $cust_bill->invnum,
- 'amount' => $amount,
- } );
- $cust_credit_bill->pkgnum( $credit->pkgnum )
- if $conf->exists('pkg-balances') && $credit->pkgnum;
- my $error = $cust_credit_bill->insert;
- if ( $error ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- die $error;
- }
-
- redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
-
- }
-
- my $total_unapplied_credits = $self->total_unapplied_credits;
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- return $total_unapplied_credits;
-}
-
-=item apply_payments [ OPTION => VALUE ... ]
-
-Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
-to outstanding invoice balances in chronological order.
-
- #and returns the value of any remaining unapplied payments.
-
-A hash of optional arguments may be passed. Currently "manual" is supported.
-If true, a payment receipt is sent instead of a statement when
-'payment_receipt_email' configuration option is set.
-
-Dies if there is an error.
-
-=cut
-
-sub apply_payments {
- my( $self, %options ) = @_;
-
- 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 }
- $self->cust_pay;
-
- my @invoices = sort { $a->_date <=> $b->_date}
- grep { $_->owed > 0 }
- $self->cust_bill;
-
- if ( $conf->exists('pkg-balances') ) {
- # limit @payments to those w/ a pkgnum grepped from $self
- my %pkgnums = ();
- foreach my $i (@invoices) {
- foreach my $li ( $i->cust_bill_pkg ) {
- $pkgnums{$li->pkgnum} = 1;
- }
- }
- @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
- }
-
- my $payment;
-
- foreach my $cust_bill ( @invoices ) {
-
- if ( !defined($payment) || $payment->unapplied == 0 ) {
- $payment = pop @payments or last;
- }
-
- my $owed;
- if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
- $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
- } else {
- $owed = $cust_bill->owed;
- }
- unless ( $owed > 0 ) {
- push @payments, $payment;
- next;
- }
-
- my $amount = min( $payment->unapplied, $owed );
-
- my $cust_bill_pay = new FS::cust_bill_pay ( {
- 'paynum' => $payment->paynum,
- 'invnum' => $cust_bill->invnum,
- 'amount' => $amount,
- } );
- $cust_bill_pay->pkgnum( $payment->pkgnum )
- if $conf->exists('pkg-balances') && $payment->pkgnum;
- my $error = $cust_bill_pay->insert(%options);
- if ( $error ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- die $error;
- }
-
- redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
-
- }
-
- my $total_unapplied_payments = $self->total_unapplied_payments;
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- return $total_unapplied_payments;
-}
-
=item total_owed
Returns the total owed for this customer on all invoices
--- /dev/null
+package FS::cust_main::Billing;
+
+use strict;
+use vars qw( $conf $DEBUG $me );
+use Carp;
+use FS::UID qw( dbh );
+use FS::Record qw( qsearch qsearchs );
+use FS::cust_bill;
+use FS::cust_bill_pkg;
+use FS::cust_bill_pkg_display;
+use FS::cust_bill_pay;
+use FS::cust_credit_bill;
+use FS::cust_pkg;
+use FS::cust_tax_adjustment;
+use FS::tax_rate;
+use FS::tax_rate_location;
+use FS::cust_bill_pkg_tax_location;
+use FS::cust_bill_pkg_tax_rate_location;
+
+# 1 is mostly method/subroutine entry and options
+# 2 traces progress of some operations
+# 3 is even more information including possibly sensitive data
+$DEBUG = 0;
+$me = '[FS::cust_main::Billing]';
+
+install_callback FS::UID sub {
+ $conf = new FS::Conf;
+ #yes, need it for stuff below (prolly should be cached)
+};
+
+=head1 NAME
+
+FS::cust_main::Billing - Billing mixin for cust_main
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTIONS
+
+These methods are available on FS::cust_main objects.
+
+=head1 METHODS
+
+=over 4
+
+=item bill_and_collect
+
+Cancels and suspends any packages due, generates bills, applies payments and
+credits, and applies collection events to run cards, send bills and notices,
+etc.
+
+By default, warns on errors and continues with the next operation (but see the
+"fatal" flag below).
+
+Options are passed as name-value pairs. Currently available options are:
+
+=over 4
+
+=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.
+
+=item check_freq
+
+"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
+
+=item resetup
+
+If set true, re-charges setup fees.
+
+=item fatal
+
+If set any errors prevent subsequent operations from continusing. If set
+specifically to "return", returns the error (or false, if there is no error).
+Any other true value causes errors to die.
+
+=item debug
+
+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
+options of those methods are also available.
+
+=cut
+
+sub bill_and_collect {
+ my( $self, %options ) = @_;
+
+ my $error;
+
+ #$options{actual_time} not $options{time} because freeside-daily -d is for
+ #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";
+ if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
+ elsif ( $options{fatal} ) { die $error; }
+ else { warn $error; }
+ }
+
+ $error = $self->suspend_adjourned_pkgs( $options{actual_time} );
+ if ( $error ) {
+ $error = "Error adjourning custnum ". $self->custnum. ": $error";
+ if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
+ elsif ( $options{fatal} ) { die $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";
+ if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
+ elsif ( $options{fatal} ) { die $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";
+ if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
+ elsif ( $options{fatal} ) { die $error; }
+ else { warn $error; }
+ }
+
+ $job->update_statustext('70,running collection events') if $job;
+ unless ( $conf->exists('cancelled_cust-noevents')
+ && ! $self->num_ncancelled_pkgs
+ ) {
+ $error = $self->collect( %options );
+ if ( $error ) {
+ $error = "Error collecting custnum ". $self->custnum. ": $error";
+ if ($options{fatal} && $options{fatal} eq 'return') { return $error; }
+ elsif ($options{fatal} ) { die $error; }
+ else { warn $error; }
+ }
+ }
+ $job->update_statustext('100,finished') if $job;
+
+ '';
+
+}
+
+sub cancel_expired_pkgs {
+ my ( $self, $time, %options ) = @_;
+
+ my @cancel_pkgs = $self->ncancelled_pkgs( {
+ 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
+ } );
+
+ my @errors = ();
+
+ foreach my $cust_pkg ( @cancel_pkgs ) {
+ my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
+ my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
+ 'reason_otaker' => $cpr->otaker
+ )
+ : ()
+ );
+ push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
+ }
+
+ scalar(@errors) ? join(' / ', @errors) : '';
+
+}
+
+sub suspend_adjourned_pkgs {
+ my ( $self, $time, %options ) = @_;
+
+ my @susp_pkgs = $self->ncancelled_pkgs( {
+ 'extra_sql' =>
+ " AND ( susp IS NULL OR susp = 0 )
+ AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
+ OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
+ )
+ ",
+ } );
+
+ #only because there's no SQL test for is_prepaid :/
+ @susp_pkgs =
+ grep { ( $_->part_pkg->is_prepaid
+ && $_->bill
+ && $_->bill < $time
+ )
+ || ( $_->adjourn
+ && $_->adjourn <= $time
+ )
+
+ }
+ @susp_pkgs;
+
+ my @errors = ();
+
+ foreach my $cust_pkg ( @susp_pkgs ) {
+ my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
+ if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
+ my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
+ 'reason_otaker' => $cpr->otaker
+ )
+ : ()
+ );
+ push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
+ }
+
+ scalar(@errors) ? join(' / ', @errors) : '';
+
+}
+
+=item bill OPTIONS
+
+Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
+conjunction with the collect method by calling B<bill_and_collect>.
+
+If there is an error, returns the error, otherwise returns false.
+
+Options are passed as name-value pairs. Currently available options are:
+
+=over 4
+
+=item resetup
+
+If set true, re-charges setup fees.
+
+=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 pkg_list
+
+An array ref of specific packages (objects) to attempt billing, instead trying all of them.
+
+ $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
+
+=item not_pkgpart
+
+A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
+
+=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.
+
+=item cancel
+
+This boolean value informs the us that the package is being cancelled. This
+typically might mean not charging the normal recurring fee but only usage
+fees since the last billing. Setup charges may be charged. Not all package
+plans support this feature (they tend to charge 0).
+
+=item invoice_terms
+
+Optional terms to be printed on this invoice. Otherwise, customer-specific
+terms or the default terms are used.
+
+=back
+
+=cut
+
+sub bill {
+ my( $self, %options ) = @_;
+ return '' if $self->payby eq 'COMP';
+ warn "$me bill customer ". $self->custnum. "\n"
+ if $DEBUG;
+
+ my $time = $options{'time'} || time;
+ my $invoice_time = $options{'invoice_time'} || $time;
+
+ $options{'not_pkgpart'} ||= {};
+ $options{'not_pkgpart'} = { map { $_ => 1 }
+ split(/\s*,\s*/, $options{'not_pkgpart'})
+ }
+ unless ref($options{'not_pkgpart'});
+
+ 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;
+
+ 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,
+ 'check_freq' => $options{'check_freq'},
+ 'stage' => 'pre-bill',
+ );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ 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 %cust_bill_pkg = map { $_ => [] } @passes;
+
+ ###
+ # find the packages which are due for billing, find out how much they are
+ # & generate invoice database.
+ ###
+
+ my %total_setup = map { my $z = 0; $_ => \$z; } @passes;
+ my %total_recur = map { my $z = 0; $_ => \$z; } @passes;
+
+ my %taxlisthash = map { $_ => {} } @passes;
+
+ my @precommit_hooks = ();
+
+ $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks?
+ foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
+
+ next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
+
+ warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
+
+ #? to avoid use of uninitialized value errors... ?
+ $cust_pkg->setfield('bill', '')
+ unless defined($cust_pkg->bill);
+
+ #my $part_pkg = $cust_pkg->part_pkg;
+
+ my $real_pkgpart = $cust_pkg->pkgpart;
+ my %hash = $cust_pkg->hash;
+
+ # 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 );
+
+ my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
+
+ my $error =
+ $self->_make_lines( 'part_pkg' => $part_pkg,
+ 'cust_pkg' => $cust_pkg,
+ 'precommit_hooks' => \@precommit_hooks,
+ 'line_items' => $cust_bill_pkg{$pass},
+ 'setup' => $total_setup{$pass},
+ 'recur' => $total_recur{$pass},
+ 'tax_matrix' => $taxlisthash{$pass},
+ 'time' => $time,
+ 'real_pkgpart' => $real_pkgpart,
+ 'options' => \%options,
+ );
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ } #foreach my $part_pkg
+
+ } #foreach my $cust_pkg
+
+ #if the customer isn't on an automatic payby, everything can go on a single
+ #invoice anyway?
+ #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) {
+ #merge everything into one list
+ #}
+
+ foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
+
+ 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
+
+ if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
+ !$conf->exists('postal_invoice-recurring_only')
+ )
+ {
+
+ my $postal_pkg = $self->charge_postal_fee();
+ if ( $postal_pkg && !ref( $postal_pkg ) ) {
+
+ $dbh->rollback if $oldAutoCommit;
+ return "can't charge postal invoice fee for customer ".
+ $self->custnum. ": $postal_pkg";
+
+ } elsif ( $postal_pkg ) {
+
+ my $real_pkgpart = $postal_pkg->pkgpart;
+ # 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 =
+ $self->_make_lines( 'part_pkg' => $part_pkg,
+ 'cust_pkg' => $postal_pkg,
+ 'precommit_hooks' => \@precommit_hooks,
+ 'line_items' => \@cust_bill_pkg,
+ 'setup' => $total_setup{$pass},
+ 'recur' => $total_recur{$pass},
+ 'tax_matrix' => $taxlisthash{$pass},
+ 'time' => $time,
+ 'real_pkgpart' => $real_pkgpart,
+ 'options' => \%postal_options,
+ );
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ # it's silly to have a zero value postal_pkg, but....
+ @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
+
+ }
+
+ }
+
+ my $listref_or_error =
+ $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
+
+ unless ( ref( $listref_or_error ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $listref_or_error;
+ }
+
+ foreach my $taxline ( @$listref_or_error ) {
+ ${ $total_setup{$pass} } =
+ sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
+ push @cust_bill_pkg, $taxline;
+ }
+
+ #add tax adjustments
+ warn "adding tax adjustments...\n" if $DEBUG > 2;
+ foreach my $cust_tax_adjustment (
+ qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
+ 'billpkgnum' => '',
+ }
+ )
+ ) {
+
+ my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
+
+ my $itemdesc = $cust_tax_adjustment->taxname;
+ $itemdesc = '' if $itemdesc eq 'Tax';
+
+ push @cust_bill_pkg, new FS::cust_bill_pkg {
+ 'pkgnum' => 0,
+ 'setup' => $tax,
+ 'recur' => 0,
+ 'sdate' => '',
+ 'edate' => '',
+ 'itemdesc' => $itemdesc,
+ 'itemcomment' => $cust_tax_adjustment->comment,
+ 'cust_tax_adjustment' => $cust_tax_adjustment,
+ #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
+ };
+
+ }
+
+ my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
+
+ my @cust_bill = $self->cust_bill;
+ my $balance = $self->balance;
+ my $previous_balance = scalar(@cust_bill)
+ ? ( $cust_bill[$#cust_bill]->billing_balance || 0 )
+ : 0;
+
+ $previous_balance += $cust_bill[$#cust_bill]->charged
+ if scalar(@cust_bill);
+ #my $balance_adjustments =
+ # sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
+
+ #create the new invoice
+ my $cust_bill = new FS::cust_bill ( {
+ 'custnum' => $self->custnum,
+ '_date' => ( $invoice_time ),
+ 'charged' => $charged,
+ 'billing_balance' => $balance,
+ 'previous_balance' => $previous_balance,
+ 'invoice_terms' => $options{'invoice_terms'},
+ } );
+ $error = $cust_bill->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't create invoice for customer #". $self->custnum. ": $error";
+ }
+
+ foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
+ $cust_bill_pkg->invnum($cust_bill->invnum);
+ my $error = $cust_bill_pkg->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't create invoice line item: $error";
+ }
+ }
+
+ } #foreach my $pass ( keys %cust_bill_pkg )
+
+ foreach my $hook ( @precommit_hooks ) {
+ eval {
+ &{$hook}; #($self) ?
+ };
+ if ( $@ ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$@ running precommit hook $hook\n";
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ ''; #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.
+
+Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
+Usually used internally by bill method B<bill>.
+
+If there is an error, returns the error, otherwise returns reference to a
+list of line items suitable for insertion.
+
+=over 4
+
+=item LINEITEMREF
+
+An array ref of the line items being billed.
+
+=item TAXHASHREF
+
+A strange beast. The keys to this hash are internal identifiers consisting
+of the name of the tax object type, a space, and its unique identifier ( e.g.
+ 'cust_main_county 23' ). The values of the hash are listrefs. The first
+item in the list is the tax object. The remaining items are either line
+items or floating point values (currency amounts).
+
+The taxes are calculated on this entity. Calculated exemption records are
+transferred to the LINEITEMREF items on the assumption that they are related.
+
+Read the source.
+
+=item INVOICE_TIME
+
+This specifies the date appearing on the associated invoice. Some
+jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
+
+=back
+
+=cut
+sub calculate_taxes {
+ my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
+
+ my @tax_line_items = ();
+
+ warn "having a look at the taxes we found...\n" if $DEBUG > 2;
+
+ # keys are tax names (as printed on invoices / itemdesc )
+ # values are listrefs of taxlisthash keys (internal identifiers)
+ my %taxname = ();
+
+ # keys are taxlisthash keys (internal identifiers)
+ # values are (cumulative) amounts
+ my %tax = ();
+
+ # keys are taxlisthash keys (internal identifiers)
+ # values are listrefs of cust_bill_pkg_tax_location hashrefs
+ my %tax_location = ();
+
+ # keys are taxlisthash keys (internal identifiers)
+ # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
+ my %tax_rate_location = ();
+
+ foreach my $tax ( keys %$taxlisthash ) {
+ my $tax_object = shift @{ $taxlisthash->{$tax} };
+ warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
+ warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
+ my $hashref_or_error =
+ $tax_object->taxline( $taxlisthash->{$tax},
+ 'custnum' => $self->custnum,
+ 'invoice_time' => $invoice_time
+ );
+ return $hashref_or_error unless ref($hashref_or_error);
+
+ unshift @{ $taxlisthash->{$tax} }, $tax_object;
+
+ my $name = $hashref_or_error->{'name'};
+ my $amount = $hashref_or_error->{'amount'};
+
+ #warn "adding $amount as $name\n";
+ $taxname{ $name } ||= [];
+ push @{ $taxname{ $name } }, $tax;
+
+ $tax{ $tax } += $amount;
+
+ $tax_location{ $tax } ||= [];
+ if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
+ push @{ $tax_location{ $tax } },
+ {
+ 'taxnum' => $tax_object->taxnum,
+ 'taxtype' => ref($tax_object),
+ 'pkgnum' => $tax_object->get('pkgnum'),
+ 'locationnum' => $tax_object->get('locationnum'),
+ 'amount' => sprintf('%.2f', $amount ),
+ };
+ }
+
+ $tax_rate_location{ $tax } ||= [];
+ if ( ref($tax_object) eq 'FS::tax_rate' ) {
+ my $taxratelocationnum =
+ $tax_object->tax_rate_location->taxratelocationnum;
+ push @{ $tax_rate_location{ $tax } },
+ {
+ 'taxnum' => $tax_object->taxnum,
+ 'taxtype' => ref($tax_object),
+ 'amount' => sprintf('%.2f', $amount ),
+ 'locationtaxid' => $tax_object->location,
+ 'taxratelocationnum' => $taxratelocationnum,
+ };
+ }
+
+ }
+
+ #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
+ my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg;
+ foreach my $tax ( keys %$taxlisthash ) {
+ foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) {
+ next unless ref($_) eq 'FS::cust_bill_pkg';
+
+ push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
+ splice( @{ $_->_cust_tax_exempt_pkg } );
+ }
+ }
+
+ #consolidate and create tax line items
+ warn "consolidating and generating...\n" if $DEBUG > 2;
+ foreach my $taxname ( keys %taxname ) {
+ my $tax = 0;
+ my %seen = ();
+ my @cust_bill_pkg_tax_location = ();
+ my @cust_bill_pkg_tax_rate_location = ();
+ warn "adding $taxname\n" if $DEBUG > 1;
+ foreach my $taxitem ( @{ $taxname{$taxname} } ) {
+ next if $seen{$taxitem}++;
+ warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
+ $tax += $tax{$taxitem};
+ push @cust_bill_pkg_tax_location,
+ map { new FS::cust_bill_pkg_tax_location $_ }
+ @{ $tax_location{ $taxitem } };
+ push @cust_bill_pkg_tax_rate_location,
+ map { new FS::cust_bill_pkg_tax_rate_location $_ }
+ @{ $tax_rate_location{ $taxitem } };
+ }
+ next unless $tax;
+
+ $tax = sprintf('%.2f', $tax );
+
+ my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
+ 'disabled' => '',
+ },
+ );
+
+ my @display = ();
+ if ( $pkg_category and
+ $conf->config('invoice_latexsummary') ||
+ $conf->config('invoice_htmlsummary')
+ )
+ {
+
+ my %hash = ( 'section' => $pkg_category->categoryname );
+ push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
+
+ }
+
+ push @tax_line_items, new FS::cust_bill_pkg {
+ 'pkgnum' => 0,
+ 'setup' => $tax,
+ 'recur' => 0,
+ 'sdate' => '',
+ 'edate' => '',
+ 'itemdesc' => $taxname,
+ 'display' => \@display,
+ 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
+ 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
+ };
+
+ }
+
+ \@tax_line_items;
+}
+
+sub _make_lines {
+ my ($self, %params) = @_;
+
+ my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
+ my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
+ my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
+ my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
+ my $total_setup = $params{setup} or die "no setup accumulator specified";
+ my $total_recur = $params{recur} or die "no recur accumulator specified";
+ my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
+ my $time = $params{'time'} or die "no time specified";
+ my (%options) = %{$params{options}};
+
+ my $dbh = dbh;
+ my $real_pkgpart = $params{real_pkgpart};
+ my %hash = $cust_pkg->hash;
+ my $old_cust_pkg = new FS::cust_pkg \%hash;
+
+ my @details = ();
+ my @discounts = ();
+ my $lineitems = 0;
+
+ $cust_pkg->pkgpart($part_pkg->pkgpart);
+
+ ###
+ # bill setup
+ ###
+
+ my $setup = 0;
+ my $unitsetup = 0;
+ if ( $options{'resetup'}
+ || ( ! $cust_pkg->setup
+ && ( ! $cust_pkg->start_date
+ || $cust_pkg->start_date <= $time
+ )
+ && ( ! $conf->exists('disable_setup_suspended_pkgs')
+ || ( $conf->exists('disable_setup_suspended_pkgs') &&
+ ! $cust_pkg->getfield('susp')
+ )
+ )
+ )
+ )
+ {
+
+ warn " bill setup\n" if $DEBUG > 1;
+ $lineitems++;
+
+ $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
+ return "$@ running calc_setup for $cust_pkg\n"
+ if $@;
+
+ $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
+
+ $cust_pkg->setfield('setup', $time)
+ unless $cust_pkg->setup;
+ #do need it, but it won't get written to the db
+ #|| $cust_pkg->pkgpart != $real_pkgpart;
+
+ $cust_pkg->setfield('start_date', '')
+ if $cust_pkg->start_date;
+
+ }
+
+ ###
+ # bill recurring fee
+ ###
+
+ #XXX unit stuff here too
+ my $recur = 0;
+ my $unitrecur = 0;
+ my $sdate;
+ if ( ! $cust_pkg->get('susp')
+ and ! $cust_pkg->get('start_date')
+ and ( $part_pkg->getfield('freq') ne '0'
+ && ( $cust_pkg->getfield('bill') || 0 ) <= $time
+ )
+ || ( $part_pkg->plan eq 'voip_cdr'
+ && $part_pkg->option('bill_every_call')
+ )
+ || ( $options{cancel} )
+ ) {
+
+ # XXX should this be a package event? probably. events are called
+ # at collection time at the moment, though...
+ $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
+ if $part_pkg->can('reset_usage');
+ #don't want to reset usage just cause we want a line item??
+ #&& $part_pkg->pkgpart == $real_pkgpart;
+
+ warn " bill recur\n" if $DEBUG > 1;
+ $lineitems++;
+
+ # XXX shared with $recur_prog
+ $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
+ || $cust_pkg->setup
+ || $time;
+
+ #over two params! lets at least switch to a hashref for the rest...
+ my $increment_next_bill = ( $part_pkg->freq ne '0'
+ && ( $cust_pkg->getfield('bill') || 0 ) <= $time
+ && !$options{cancel}
+ );
+ 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';
+ $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
+ return "$@ running $method for $cust_pkg\n"
+ if ( $@ );
+
+ if ( $increment_next_bill ) {
+
+ my $next_bill = $part_pkg->add_freq($sdate);
+ return "unparsable frequency: ". $part_pkg->freq
+ if $next_bill == -1;
+
+ #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
+ # only for figuring next bill date, nothing else, so, reset $sdate again
+ # here
+ $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
+ #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
+ $cust_pkg->last_bill($sdate);
+
+ $cust_pkg->setfield('bill', $next_bill );
+
+ }
+
+ }
+
+ warn "\$setup is undefined" unless defined($setup);
+ warn "\$recur is undefined" unless defined($recur);
+ warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
+
+ ###
+ # If there's line items, create em cust_bill_pkg records
+ # If $cust_pkg has been modified, update it (if we're a real pkgpart)
+ ###
+
+ 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?
+
+ warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
+ if $DEBUG >1;
+
+ my $error = $cust_pkg->replace( $old_cust_pkg,
+ 'options' => { $cust_pkg->options },
+ );
+ return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
+ if $error; #just in case
+ }
+
+ $setup = sprintf( "%.2f", $setup );
+ $recur = sprintf( "%.2f", $recur );
+ if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
+ return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
+ }
+ if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
+ return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
+ }
+
+ 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 @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
+ if ( $DEBUG > 1 ) {
+ warn " adding customer package invoice detail: $_\n"
+ foreach @cust_pkg_detail;
+ }
+ push @details, @cust_pkg_detail;
+
+ my $cust_bill_pkg = new FS::cust_bill_pkg {
+ 'pkgnum' => $cust_pkg->pkgnum,
+ 'setup' => $setup,
+ 'unitsetup' => $unitsetup,
+ 'recur' => $recur,
+ 'unitrecur' => $unitrecur,
+ 'quantity' => $cust_pkg->quantity,
+ 'details' => \@details,
+ 'discounts' => \@discounts,
+ 'hidden' => $part_pkg->hidden,
+ };
+
+ if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
+ $cust_bill_pkg->sdate( $hash{last_bill} );
+ $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
+ $cust_bill_pkg->edate( $time ) if $options{cancel};
+ } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
+ $cust_bill_pkg->sdate( $sdate );
+ $cust_bill_pkg->edate( $cust_pkg->bill );
+ #$cust_bill_pkg->edate( $time ) if $options{cancel};
+ }
+
+ $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
+ unless $part_pkg->pkgpart == $real_pkgpart;
+
+ $$total_setup += $setup;
+ $$total_recur += $recur;
+
+ ###
+ # handle taxes
+ ###
+
+ my $error =
+ $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
+ return $error if $error;
+
+ push @$cust_bill_pkgs, $cust_bill_pkg;
+
+ } #if $setup != 0 || $recur != 0
+
+ } #if $line_items
+
+ '';
+
+}
+
+sub _handle_taxes {
+ my $self = shift;
+ my $part_pkg = shift;
+ my $taxlisthash = shift;
+ my $cust_bill_pkg = shift;
+ my $cust_pkg = shift;
+ my $invoice_time = shift;
+ my $real_pkgpart = shift;
+ my $options = shift;
+
+ my %cust_bill_pkg = ();
+ my %taxes = ();
+
+ my @classes;
+ #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
+ push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
+ push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
+ push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
+
+ if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
+
+ if ( $conf->exists('enable_taxproducts')
+ && ( scalar($part_pkg->part_pkg_taxoverride)
+ || $part_pkg->has_taxproduct
+ )
+ )
+ {
+
+ if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
+ return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
+ }
+
+ foreach my $class (@classes) {
+ my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
+ return $err_or_ref unless ref($err_or_ref);
+ $taxes{$class} = $err_or_ref;
+ }
+
+ unless (exists $taxes{''}) {
+ my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
+ return $err_or_ref unless ref($err_or_ref);
+ $taxes{''} = $err_or_ref;
+ }
+
+ } else {
+
+ my @loc_keys = qw( city county state country );
+ my %taxhash;
+ if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
+ my $cust_location = $cust_pkg->cust_location;
+ %taxhash = map { $_ => $cust_location->$_() } @loc_keys;
+ } else {
+ my $prefix =
+ ( $conf->exists('tax-ship_address') && length($self->ship_last) )
+ ? 'ship_'
+ : '';
+ %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
+ }
+
+ $taxhash{'taxclass'} = $part_pkg->taxclass;
+
+ my @taxes = ();
+ my %taxhash_elim = %taxhash;
+ my @elim = qw( city county state );
+ do {
+
+ #first try a match with taxclass
+ @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
+
+ if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
+ #then try a match without taxclass
+ my %no_taxclass = %taxhash_elim;
+ $no_taxclass{ 'taxclass' } = '';
+ @taxes = qsearch( 'cust_main_county', \%no_taxclass );
+ }
+
+ $taxhash_elim{ shift(@elim) } = '';
+
+ } while ( !scalar(@taxes) && scalar(@elim) );
+
+ @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
+ @taxes
+ if $self->cust_main_exemption; #just to be safe
+
+ if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
+ foreach (@taxes) {
+ $_->set('pkgnum', $cust_pkg->pkgnum );
+ $_->set('locationnum', $cust_pkg->locationnum );
+ }
+ }
+
+ $taxes{''} = [ @taxes ];
+ $taxes{'setup'} = [ @taxes ];
+ $taxes{'recur'} = [ @taxes ];
+ $taxes{$_} = [ @taxes ] foreach (@classes);
+
+ # # maybe eliminate this entirely, along with all the 0% records
+ # unless ( @taxes ) {
+ # return
+ # "fatal: can't find tax rate for state/county/country/taxclass ".
+ # join('/', map $taxhash{$_}, qw(state county country taxclass) );
+ # }
+
+ } #if $conf->exists('enable_taxproducts') ...
+
+ }
+
+ my @display = ();
+ my $separate = $conf->exists('separate_usage');
+ 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 %hash = ( 'section' => $section );
+
+ $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 };
+ } else {
+ push @display, new FS::cust_bill_pkg_display
+ { type => '',
+ %hash,
+ ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
+ };
+ }
+
+ if ($separate && $section && $summary) {
+ push @display, new FS::cust_bill_pkg_display { type => 'U',
+ summary => 'Y',
+ %hash,
+ };
+ }
+ if ($usage_mandate || $section && $summary) {
+ $hash{post_total} = 'Y';
+ }
+
+ 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 %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
+ foreach my $key (keys %tax_cust_bill_pkg) {
+ my @taxes = @{ $taxes{$key} || [] };
+ my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
+
+ my %localtaxlisthash = ();
+ foreach my $tax ( @taxes ) {
+
+ my $taxname = ref( $tax ). ' '. $tax->taxnum;
+# $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
+# ' locationnum'. $cust_pkg->locationnum
+# if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
+
+ $taxlisthash->{ $taxname } ||= [ $tax ];
+ push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
+
+ $localtaxlisthash{ $taxname } ||= [ $tax ];
+ push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
+
+ }
+
+ warn "finding taxed taxes...\n" if $DEBUG > 2;
+ foreach my $tax ( keys %localtaxlisthash ) {
+ my $tax_object = shift @{ $localtaxlisthash{$tax} };
+ warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
+ if $DEBUG > 2;
+ next unless $tax_object->can('tax_on_tax');
+
+ foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
+ my $totname = ref( $tot ). ' '. $tot->taxnum;
+
+ warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
+ if $DEBUG > 2;
+ next unless exists( $localtaxlisthash{ $totname } ); # only increase
+ # existing taxes
+ warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
+ my $hashref_or_error =
+ $tax_object->taxline( $localtaxlisthash{$tax},
+ 'custnum' => $self->custnum,
+ 'invoice_time' => $invoice_time,
+ );
+ return $hashref_or_error
+ unless ref($hashref_or_error);
+
+ $taxlisthash->{ $totname } ||= [ $tot ];
+ push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
+
+ }
+ }
+
+ }
+
+ '';
+}
+
+sub _gather_taxes {
+ my $self = shift;
+ my $part_pkg = shift;
+ my $class = shift;
+
+ my @taxes = ();
+ my $geocode = $self->geocode('cch');
+
+ my @taxclassnums = map { $_->taxclassnum }
+ $part_pkg->part_pkg_taxoverride($class);
+
+ unless (@taxclassnums) {
+ @taxclassnums = map { $_->taxclassnum }
+ grep { $_->taxable eq 'Y' }
+ $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
+ }
+ warn "Found taxclassnum values of ". join(',', @taxclassnums)
+ if $DEBUG;
+
+ my $extra_sql =
+ "AND (".
+ join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
+
+ @taxes = qsearch({ 'table' => 'tax_rate',
+ 'hashref' => { 'geocode' => $geocode, },
+ 'extra_sql' => $extra_sql,
+ })
+ if scalar(@taxclassnums);
+
+ warn "Found taxes ".
+ join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
+ if $DEBUG;
+
+ [ @taxes ];
+
+}
+
+=item collect [ HASHREF | OPTION => VALUE ... ]
+
+(Attempt to) collect money for this customer's outstanding invoices (see
+L<FS::cust_bill>). Usually used after the bill method.
+
+Actions are now triggered by billing events; see L<FS::part_event> and the
+billing events web interface. Old-style invoice events (see
+L<FS::part_bill_event>) have been deprecated.
+
+If there is an error, returns the error, otherwise returns false.
+
+Options are passed as name-value pairs.
+
+Currently available options are:
+
+=over 4
+
+=item invoice_time
+
+Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=item retry
+
+Retry card/echeck/LEC transactions even when not scheduled by invoice events.
+
+=item check_freq
+
+"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
+
+=item quiet
+
+set true to surpress email card/ACH decline notices.
+
+=item debug
+
+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)
+
+=back
+
+# =item payby
+#
+# allows for one time override of normal customer billing method
+
+=cut
+
+sub collect {
+ my( $self, %options ) = @_;
+ my $invoice_time = $options{'invoice_time'} || time;
+
+ #put below somehow?
+ 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
+
+ if ( $DEBUG ) {
+ my $balance = $self->balance;
+ warn "$me collect customer ". $self->custnum. ": balance $balance\n"
+ }
+
+ if ( exists($options{'retry_card'}) ) {
+ carp 'retry_card option passed to collect is deprecated; use retry';
+ $options{'retry'} ||= $options{'retry_card'};
+ }
+ if ( exists($options{'retry'}) && $options{'retry'} ) {
+ my $error = $self->retry_realtime;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $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',
+ );
+
+}
+
+
+=item apply_payments_and_credits [ OPTION => VALUE ... ]
+
+Applies unapplied payments and credits.
+
+In most cases, this new method should be used in place of sequential
+apply_payments and apply_credits methods.
+
+A hash of optional arguments may be passed. Currently "manual" is supported.
+If true, a payment receipt is sent instead of a statement when
+'payment_receipt_email' configuration option is set.
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub apply_payments_and_credits {
+ my( $self, %options ) = @_;
+
+ 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 ) {
+ my $error = $cust_bill->apply_payments_and_credits(%options);
+ 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 ...
+
+Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
+to outstanding invoice balances in chronological order (or reverse
+chronological order if the I<order> option is set to B<newest>) and returns the
+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 = @_;
+
+ 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_unapplied_credits ) {
+ $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 } ) );
+
+ my @invoices = $self->open_cust_bill;
+ @invoices = sort { $b->_date <=> $a->_date } @invoices
+ if defined($opt{'order'}) && $opt{'order'} eq 'newest';
+
+ if ( $conf->exists('pkg-balances') ) {
+ # limit @credits to those w/ a pkgnum grepped from $self
+ my %pkgnums = ();
+ foreach my $i (@invoices) {
+ foreach my $li ( $i->cust_bill_pkg ) {
+ $pkgnums{$li->pkgnum} = 1;
+ }
+ }
+ @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
+ }
+
+ my $credit;
+
+ foreach my $cust_bill ( @invoices ) {
+
+ if ( !defined($credit) || $credit->credited == 0) {
+ $credit = pop @credits or last;
+ }
+
+ my $owed;
+ if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
+ $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
+ } else {
+ $owed = $cust_bill->owed;
+ }
+ unless ( $owed > 0 ) {
+ push @credits, $credit;
+ next;
+ }
+
+ my $amount = min( $credit->credited, $owed );
+
+ my $cust_credit_bill = new FS::cust_credit_bill ( {
+ 'crednum' => $credit->crednum,
+ 'invnum' => $cust_bill->invnum,
+ 'amount' => $amount,
+ } );
+ $cust_credit_bill->pkgnum( $credit->pkgnum )
+ if $conf->exists('pkg-balances') && $credit->pkgnum;
+ my $error = $cust_credit_bill->insert;
+ if ( $error ) {
+ $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+ die $error;
+ }
+
+ redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
+
+ }
+
+ my $total_unapplied_credits = $self->total_unapplied_credits;
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ return $total_unapplied_credits;
+}
+
+=item apply_payments [ OPTION => VALUE ... ]
+
+Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
+to outstanding invoice balances in chronological order.
+
+ #and returns the value of any remaining unapplied payments.
+
+A hash of optional arguments may be passed. Currently "manual" is supported.
+If true, a payment receipt is sent instead of a statement when
+'payment_receipt_email' configuration option is set.
+
+Dies if there is an error.
+
+=cut
+
+sub apply_payments {
+ my( $self, %options ) = @_;
+
+ 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 }
+ $self->cust_pay;
+
+ my @invoices = sort { $a->_date <=> $b->_date}
+ grep { $_->owed > 0 }
+ $self->cust_bill;
+
+ if ( $conf->exists('pkg-balances') ) {
+ # limit @payments to those w/ a pkgnum grepped from $self
+ my %pkgnums = ();
+ foreach my $i (@invoices) {
+ foreach my $li ( $i->cust_bill_pkg ) {
+ $pkgnums{$li->pkgnum} = 1;
+ }
+ }
+ @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
+ }
+
+ my $payment;
+
+ foreach my $cust_bill ( @invoices ) {
+
+ if ( !defined($payment) || $payment->unapplied == 0 ) {
+ $payment = pop @payments or last;
+ }
+
+ my $owed;
+ if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
+ $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
+ } else {
+ $owed = $cust_bill->owed;
+ }
+ unless ( $owed > 0 ) {
+ push @payments, $payment;
+ next;
+ }
+
+ my $amount = min( $payment->unapplied, $owed );
+
+ my $cust_bill_pay = new FS::cust_bill_pay ( {
+ 'paynum' => $payment->paynum,
+ 'invnum' => $cust_bill->invnum,
+ 'amount' => $amount,
+ } );
+ $cust_bill_pay->pkgnum( $payment->pkgnum )
+ if $conf->exists('pkg-balances') && $payment->pkgnum;
+ my $error = $cust_bill_pay->insert(%options);
+ if ( $error ) {
+ $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+ die $error;
+ }
+
+ redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
+
+ }
+
+ my $total_unapplied_payments = $self->total_unapplied_payments;
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ return $total_unapplied_payments;
+}
+
+1;
--- /dev/null
+package FS::cust_main::Billing_Realtime;
+
+use strict;
+use vars qw( $conf $DEBUG $me );
+use FS::UID qw( dbh );
+use FS::Record qw( qsearch qsearchs );
+use FS::payby;
+use FS::cust_pay;
+use FS::cust_pay_pending;
+use FS::cust_refund;
+
+#$realtime_bop_decline_quiet = 0;
+
+# 1 is mostly method/subroutine entry and options
+# 2 traces progress of some operations
+# 3 is even more information including possibly sensitive data
+$DEBUG = 0;
+$me = '[FS::cust_main::Billing_Realtime]';
+
+install_callback FS::UID sub {
+ $conf = new FS::Conf;
+ #yes, need it for stuff below (prolly should be cached)
+};
+
+=head1 NAME
+
+FS::cust_main::Billing_Realtime - Realtime billing mixin for cust_main
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTIONS
+
+These methods are available on FS::cust_main objects.
+
+=head1 METHODS
+
+=over 4
+
+=item realtime_collect [ OPTION => VALUE ... ]
+
+Runs a realtime credit card, ACH (electronic check) or phone bill transaction
+via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
+gateway. See L<http://420.am/business-onlinepayment> and
+L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
+
+On failure returns an error message.
+
+Returns false or a hashref upon success. The hashref contains keys popup_url reference, and collectitems. The first is a URL to which a browser should be redirected for completion of collection. The second is a reference id for the transaction suitable for the end user. The collectitems is a reference to a list of name value pairs suitable for assigning to a html form and posted to popup_url.
+
+Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>, I<pkgnum>
+
+I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified
+then it is deduced from the customer record.
+
+If no I<amount> is specified, then the customer balance is used.
+
+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.
+
+I<session_id> is a session identifier associated with this payment.
+
+I<depend_jobnum> allows payment capture to unlock export jobs
+
+=cut
+
+sub realtime_collect {
+ my( $self, %options ) = @_;
+
+ if ( $DEBUG ) {
+ warn "$me realtime_collect:\n";
+ warn " $_ => $options{$_}\n" foreach keys %options;
+ }
+
+ $options{amount} = $self->balance unless exists( $options{amount} );
+ $options{method} = FS::payby->payby2bop($self->payby)
+ unless exists( $options{method} );
+
+ return $self->realtime_bop({%options});
+
+}
+
+=item realtime_bop { [ ARG => 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.
+
+Required arguments in the hashref are I<method>, and I<amount>
+
+Available methods are: I<CC>, I<ECHECK> and I<LEC>
+
+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 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.
+
+I<session_id> is a session identifier associated with this payment.
+
+I<depend_jobnum> allows payment capture to unlock export jobs
+
+(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
+
+=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} = $self->agent->payment_gateway( %$options )
+ unless exists($options->{payment_gateway});
+
+ $options->{payment_gateway};
+}
+
+sub _bop_auth {
+ my ($self, $options) = @_;
+
+ (
+ 'login' => $options->{payment_gateway}->gateway_username,
+ 'password' => $options->{payment_gateway}->gateway_password,
+ );
+}
+
+sub _bop_options {
+ my ($self, $options) = @_;
+
+ $options->{payment_gateway}->gatewaynum
+ ? $options->{payment_gateway}->options
+ : @{ $options->{payment_gateway}->get('options') };
+
+}
+
+sub _bop_defaults {
+ my ($self, $options) = @_;
+
+ 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';
+ }
+ }
+
+ $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
+ $options->{invnum} ||= '';
+ $options->{payname} = $self->payname unless exists( $options->{payname} );
+}
+
+sub _bop_content {
+ my ($self, $options) = @_;
+ 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 ($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{name} = $payname;
+
+ $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}
+ : $self->city;
+ $content{state} = exists($options->{state})
+ ? $options->{state}
+ : $self->state;
+ $content{zip} = exists($options->{zip})
+ ? $options->{'zip'}
+ : $self->zip;
+ $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;
+}
+
+my %bop_method2payby = (
+ 'CC' => 'CARD',
+ 'ECHECK' => 'CHEK',
+ 'LEC' => 'LECB',
+);
+
+sub realtime_bop {
+ my $self = shift;
+
+ my %options = ();
+ if (ref($_[0]) eq 'HASH') {
+ %options = %{$_[0]};
+ } else {
+ my ( $method, $amount ) = ( shift, shift );
+ %options = @_;
+ $options{method} = $method;
+ $options{amount} = $amount;
+ }
+
+ if ( $DEBUG ) {
+ warn "$me realtime_bop (new): $options{method} $options{amount}\n";
+ warn " $_ => $options{$_}\n" foreach keys %options;
+ }
+
+ return $self->fake_bop(%options) if $options{'fake'};
+
+ $self->_bop_defaults(\%options);
+
+ ###
+ # set trans_is_recur based on invnum if there is one
+ ###
+
+ 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;
+
+ $trans_is_recur = 1
+ if grep { $_->freq ne '0' } @part_pkg;
+
+ }
+
+ ###
+ # select a gateway
+ ###
+
+ my $payment_gateway = $self->_payment_gateway( \%options );
+ my $namespace = $payment_gateway->gateway_namespace;
+
+ eval "use $namespace";
+ die $@ if $@;
+
+ ###
+ # check for banned credit card/ACH
+ ###
+
+ my $ban = qsearchs('banned_pay', {
+ 'payby' => $bop_method2payby{$options{method}},
+ 'payinfo' => md5_base64($options{payinfo}),
+ } );
+ return "Banned credit card" if $ban;
+
+ ###
+ # massage data
+ ###
+
+ 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')
+ || $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 $paydate = '';
+ my %content = ();
+ if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
+
+ $content{card_number} = $options{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' => $options{'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 ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
+ ( $content{account_number}, $content{routing_code} ) =
+ split('@', $options{payinfo});
+ $content{bank_name} = $options{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} = $self->getfield('first'). ' '.
+ $self->getfield('last');
+
+ $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 ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
+ $content{phone} = $options{payinfo};
+ } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
+ #move along
+ } else {
+ #die an evil death
+ }
+
+ ###
+ # 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; $options{method} transaction aborted."
+ if $self->balance < $balance;
+ #&& $self->balance < $options{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 ).
+ "); $options{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' => $options{amount},
+ '_date' => '',
+ 'payby' => $bop_method2payby{$options{method}},
+ 'payinfo' => $options{payinfo},
+ 'paydate' => $paydate,
+ 'recurring_billing' => $content{recurring_billing},
+ 'pkgnum' => $options{'pkgnum'},
+ 'status' => 'new',
+ 'gatewaynum' => $payment_gateway->gatewaynum || '',
+ 'session_id' => $options{session_id} || '',
+ 'jobnum' => $options{depend_jobnum} || '',
+ };
+ $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*/, $payment_gateway->gateway_action );
+
+ my $transaction = new $namespace( $payment_gateway->gateway_module,
+ $self->_bop_options(\%options),
+ );
+
+ $transaction->content(
+ 'type' => $options{method},
+ $self->_bop_auth(\%options),
+ 'action' => $action1,
+ 'description' => $options{'description'},
+ 'amount' => $options{amount},
+ #'invoice_number' => $options{'invnum'},
+ 'customer_id' => $self->custnum,
+ %$bop_content,
+ 'reference' => $cust_pay_pending->paypendingnum, #for now
+ 'email' => $email,
+ %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->test_transaction(1)
+ if $conf->exists('business-onlinepayment-test_transaction');
+ $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() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
+
+ return { reference => $cust_pay_pending->paypendingnum,
+ map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
+
+ } elsif ( $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( $payment_gateway->gateway_module,
+ $self->_bop_options(\%options),
+ );
+
+ my %capture = (
+ %content,
+ type => $options{method},
+ action => $action2,
+ $self->_bop_auth(\%options),
+ order_number => $ordernum,
+ amount => $options{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->test_transaction(1)
+ if $conf->exists('business-onlinepayment-test_transaction');
+ $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;
+ }
+
+ }
+
+ ###
+ # remove paycvv after initial transaction
+ ###
+
+ #false laziness w/misc/process/payment.cgi - check both to make sure working
+ # correctly
+ if ( length($self->paycvv)
+ && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
+ ) {
+ my $error = $self->remove_cvv;
+ if ( $error ) {
+ warn "WARNING: error removing cvv: $error\n";
+ }
+ }
+
+ ###
+ # 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
+ ###
+
+ $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
+
+}
+
+=item fake_bop
+
+=cut
+
+sub fake_bop {
+ my $self = shift;
+
+ my %options = ();
+ if (ref($_[0]) eq 'HASH') {
+ %options = %{$_[0]};
+ } else {
+ my ( $method, $amount ) = ( shift, shift );
+ %options = @_;
+ $options{method} = $method;
+ $options{amount} = $amount;
+ }
+
+ if ( $options{'fake_failure'} ) {
+ return "Error: No error; test failure requested with fake_failure";
+ }
+
+ #my $paybatch = '';
+ #if ( $payment_gateway->gatewaynum ) { # agent override
+ # $paybatch = $payment_gateway->gatewaynum. '-';
+ #}
+ #
+ #$paybatch .= "$processor:". $transaction->authorization;
+ #
+ #$paybatch .= ':'. $transaction->order_number
+ # if $transaction->can('order_number')
+ # && length($transaction->order_number);
+
+ my $paybatch = 'FakeProcessor:54:32';
+
+ my $cust_pay = new FS::cust_pay ( {
+ 'custnum' => $self->custnum,
+ 'invnum' => $options{'invnum'},
+ 'paid' => $options{amount},
+ '_date' => '',
+ 'payby' => $bop_method2payby{$options{method}},
+ #'payinfo' => $payinfo,
+ 'payinfo' => '4111111111111111',
+ 'paybatch' => $paybatch,
+ #'paydate' => $paydate,
+ 'paydate' => '2012-05-01',
+ } );
+ $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
+
+ 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, even with transactions.
+ my $e = 'WARNING: Card/ACH debited but database not updated - '.
+ "error inserting (fake!) payment: $error2".
+ " (previously tried insert with invnum #$options{'invnum'}" .
+ ": $error )";
+ warn $e;
+ return $e;
+ }
+ }
+
+ if ( $options{'paynum_ref'} ) {
+ ${ $options{'paynum_ref'} } = $cust_pay->paynum;
+ }
+
+ return ''; #no error
+
+}
+
+
+# item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
+#
+# Wraps up processing of a realtime credit card, ACH (electronic check) or
+# phone bill transaction.
+
+sub _realtime_bop_result {
+ my( $self, $cust_pay_pending, $transaction, %options ) = @_;
+ if ( $DEBUG ) {
+ warn "$me _realtime_bop_result: pending transaction ".
+ $cust_pay_pending->paypendingnum. "\n";
+ warn " $_ => $options{$_}\n" foreach keys %options;
+ }
+
+ my $payment_gateway = $options{payment_gateway}
+ or return "no payment gateway in arguments to _realtime_bop_result";
+
+ $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;
+
+ if ( $transaction->is_success() ) {
+
+ my $paybatch = '';
+ if ( $payment_gateway->gatewaynum ) { # agent override
+ $paybatch = $payment_gateway->gatewaynum. '-';
+ }
+
+ $paybatch .= $payment_gateway->gateway_module. ":".
+ $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' => $cust_pay_pending->paid,
+ '_date' => '',
+ 'payby' => $cust_pay_pending->payby,
+ 'payinfo' => $options{'payinfo'},
+ 'paybatch' => $paybatch,
+ 'paydate' => $cust_pay_pending->paydate,
+ 'pkgnum' => $cust_pay_pending->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: $options{method} captured but payment not recorded -".
+ " error inserting payment (". $payment_gateway->gateway_module.
+ "): $error2".
+ " (previously tried insert with invnum #$options{'invnum'}" .
+ ": $error ) - pending payment saved as paypendingnum ".
+ $cust_pay_pending->paypendingnum. "\n";
+ warn $e;
+ return $e;
+ }
+ }
+
+ my $jobnum = $cust_pay_pending->jobnum;
+ if ( $jobnum ) {
+ my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
+
+ unless ( $placeholder ) {
+ $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+ my $e = "WARNING: $options{method} captured but job $jobnum not ".
+ "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
+ warn $e;
+ return $e;
+ }
+
+ $error = $placeholder->delete;
+
+ if ( $error ) {
+ $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+ my $e = "WARNING: $options{method} captured but could not delete ".
+ "job $jobnum for paypendingnum ".
+ $cust_pay_pending->paypendingnum. ": $error\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: $options{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 = $payment_gateway->gateway_module. " error: ".
+ $transaction->error_message;
+
+ my $jobnum = $cust_pay_pending->jobnum;
+ if ( $jobnum ) {
+ my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
+
+ if ( $placeholder ) {
+ my $error = $placeholder->depended_delete;
+ $error ||= $placeholder->delete;
+ warn "error removing provisioning jobs after declined paypendingnum ".
+ $cust_pay_pending->paypendingnum. "\n";
+ } else {
+ my $e = "error finding job $jobnum for declined paypendingnum ".
+ $cust_pay_pending->paypendingnum. "\n";
+ warn $e;
+ }
+
+ }
+
+ 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 ".
+ $payment_gateway->gateway_module;
+ }
+
+ $perror .= "No error_message returned from ".
+ $payment_gateway->gateway_module. " -- ".
+ ( ref($t_response) ? Dumper($t_response) : $t_response );
+
+ }
+
+ if ( !$options{'quiet'} && !$FS::cust_main::realtime_bop_decline_quiet
+ && $conf->exists('emaildecline')
+ && grep { $_ ne 'POST' } $self->invoicing_list
+ && ! grep { $transaction->error_message =~ /$_/ }
+ $conf->config('emaildecline-exclude')
+ ) {
+
+ # 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;
+
+ }
+
+ $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: $options{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;
+ }
+
+}
+
+=item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
+
+Verifies successful third party processing of a realtime credit card,
+ACH (electronic check) or phone bill transaction via a
+Business::OnlineThirdPartyPayment realtime gateway. See
+L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
+
+Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
+
+The additional options I<payname>, I<city>, I<state>,
+I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
+if set, will override the value from the customer record.
+
+I<description> is a free-text field passed to the gateway. It defaults to
+"Internet services".
+
+If an I<invnum> is specified, this payment (if 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.
+
+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.
+
+Returns a hashref containing elements bill_error (which will be undefined
+upon success) and session_id of any associated session.
+
+=cut
+
+sub realtime_botpp_capture {
+ my( $self, $cust_pay_pending, %options ) = @_;
+ if ( $DEBUG ) {
+ warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
+ warn " $_ => $options{$_}\n" foreach keys %options;
+ }
+
+ eval "use Business::OnlineThirdPartyPayment";
+ die $@ if $@;
+
+ ###
+ # select the gateway
+ ###
+
+ my $method = FS::payby->payby2bop($cust_pay_pending->payby);
+
+ my $payment_gateway = $cust_pay_pending->gatewaynum
+ ? qsearchs( 'payment_gateway',
+ { gatewaynum => $cust_pay_pending->gatewaynum }
+ )
+ : $self->agent->payment_gateway( 'method' => $method,
+ # 'invnum' => $cust_pay_pending->invnum,
+ # 'payinfo' => $cust_pay_pending->payinfo,
+ );
+
+ $options{payment_gateway} = $payment_gateway; # for the helper subs
+
+ ###
+ # massage data
+ ###
+
+ 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 = ();
+
+ $content{email_customer} =
+ ( $conf->exists('business-onlinepayment-email_customer')
+ || $conf->exists('business-onlinepayment-email-override') );
+
+ ###
+ # run transaction(s)
+ ###
+
+ my $transaction =
+ new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
+ $self->_bop_options(\%options),
+ );
+
+ $transaction->reference({ %options });
+
+ $transaction->content(
+ 'type' => $method,
+ $self->_bop_auth(\%options),
+ 'action' => 'Post Authorization',
+ 'description' => $options{'description'},
+ 'amount' => $cust_pay_pending->paid,
+ #'invoice_number' => $options{'invnum'},
+ 'customer_id' => $self->custnum,
+ 'referer' => 'http://cleanwhisker.420.am/',
+ 'reference' => $cust_pay_pending->paypendingnum,
+ 'email' => $email,
+ 'phone' => $self->daytime || $self->night,
+ %content, #after
+ # plus whatever is required for bogus capture avoidance
+ );
+
+ $transaction->submit();
+
+ my $error =
+ $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
+
+ {
+ bill_error => $error,
+ session_id => $cust_pay_pending->session_id,
+ }
+
+}
+
+=item default_payment_gateway
+
+DEPRECATED -- use agent->payment_gateway
+
+=cut
+
+sub default_payment_gateway {
+ my( $self, $method ) = @_;
+
+ die "Real-time processing not enabled\n"
+ unless $conf->exists('business-onlinepayment');
+
+ #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
+
+ #load up config
+ my $bop_config = 'business-onlinepayment';
+ $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';
+ pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
+ die "No real-time processor is enabled - ".
+ "did you set the business-onlinepayment configuration value?\n"
+ unless $processor;
+
+ ( $processor, $login, $password, $action, @bop_options )
+}
+
+=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;
+
+ my %options = ();
+ if (ref($_[0]) eq 'HASH') {
+ %options = %{$_[0]};
+ } else {
+ my $method = shift;
+ %options = @_;
+ $options{method} = $method;
+ }
+
+ if ( $DEBUG ) {
+ warn "$me realtime_refund_bop (new): $options{method} refund\n";
+ warn " $_ => $options{$_}\n" foreach keys %options;
+ }
+
+ ###
+ # 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, $namespace ) ;
+ 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;
+ $namespace = $payment_gateway->gateway_namespace;
+ @bop_options = $payment_gateway->options;
+
+ } else { #try the default gateway
+
+ my $conf_processor;
+ my $payment_gateway =
+ $self->agent->payment_gateway('method' => $options{method});
+
+ ( $conf_processor, $login, $password, $namespace ) =
+ map { my $method = "gateway_$_"; $payment_gateway->$method }
+ qw( module username password namespace );
+
+ @bop_options = $payment_gateway->gatewaynum
+ ? $payment_gateway->options
+ : @{ $payment_gateway->get('options') };
+
+ 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 $payment_gateway =
+ $self->agent->payment_gateway( 'method' => $options{method},
+ #'payinfo' => $payinfo,
+ );
+ my( $processor, $login, $password, $namespace ) =
+ map { my $method = "gateway_$_"; $payment_gateway->$method }
+ qw( module username password namespace );
+
+ my @bop_options = $payment_gateway->gatewaynum
+ ? $payment_gateway->options
+ : @{ $payment_gateway->get('options') };
+
+ }
+ return "neither amount nor paynum specified" unless $amount;
+
+ eval "use $namespace";
+ die $@ if $@;
+
+ my %content = (
+ 'type' => $options{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->test_transaction(1)
+ if $conf->exists('business-onlinepayment-test_transaction');
+ $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 && $options{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 ( $options{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 ( $options{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 ( $options{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->test_transaction(1)
+ if $conf->exists('business-onlinepayment-test_transaction');
+ $refund->submit();
+
+ return "$processor error: ". $refund->error_message
+ unless $refund->is_success();
+
+ 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' => $bop_method2payby{$options{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;
+ }
+ }
+
+ ''; #no error
+
+}
+
+=back
+
+=head1 BUGS
+
+Not autoloaded.
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, L<FS::cust_main::Billing>
+
+=cut
+
+1;
projects / freeside.git / commitdiff