[freeside-commits] freeside/FS/FS/cust_main Billing.pm, 1.1, 1.2 Billing_Realtime.pm, 1.2, 1.3
Ivan,,,
ivan at wavetail.420.am
Sat Sep 18 17:13:07 PDT 2010
Update of /home/cvs/cvsroot/freeside/FS/FS/cust_main
In directory wavetail.420.am:/tmp/cvs-serv16235/FS/FS/cust_main
Modified Files:
Billing.pm Billing_Realtime.pm
Log Message:
should speed up billing (well, event checking) significantly by eliminating unnecessary target objects one level up in the loop, RT#6802
Index: Billing_Realtime.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main/Billing_Realtime.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -d -r1.2 -r1.3
--- Billing_Realtime.pm 17 Sep 2010 23:32:33 -0000 1.2
+++ Billing_Realtime.pm 19 Sep 2010 00:13:05 -0000 1.3
@@ -2,6 +2,7 @@
use strict;
use vars qw( $conf $DEBUG $me );
+use vars qw( $realtime_bop_decline_quiet ); #ugh
use FS::UID qw( dbh );
use FS::Record qw( qsearch qsearchs );
use FS::Misc qw( send_email );
@@ -10,7 +11,7 @@
use FS::cust_pay_pending;
use FS::cust_refund;
-#$realtime_bop_decline_quiet = 0;
+$realtime_bop_decline_quiet = 0;
# 1 is mostly method/subroutine entry and options
# 2 traces progress of some operations
@@ -887,7 +888,7 @@
}
- if ( !$options{'quiet'} && !$FS::cust_main::realtime_bop_decline_quiet
+ if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
&& $conf->exists('emaildecline')
&& grep { $_ ne 'POST' } $self->invoicing_list
&& ! grep { $transaction->error_message =~ /$_/ }
Index: Billing.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main/Billing.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -d -r1.1 -r1.2
--- Billing.pm 17 Sep 2010 20:19:41 -0000 1.1
+++ Billing.pm 19 Sep 2010 00:13:05 -0000 1.2
@@ -4,7 +4,7 @@
use vars qw( $conf $DEBUG $me );
use Carp;
use FS::UID qw( dbh );
-use FS::Record qw( qsearch qsearchs );
+use FS::Record qw( qsearch qsearchs dbdef );
use FS::cust_bill;
use FS::cust_bill_pkg;
use FS::cust_bill_pkg_display;
@@ -16,6 +16,8 @@
use FS::tax_rate_location;
use FS::cust_bill_pkg_tax_location;
use FS::cust_bill_pkg_tax_rate_location;
+use FS::part_event;
+use FS::part_event_condition;
# 1 is mostly method/subroutine entry and options
# 2 traces progress of some operations
@@ -1307,6 +1309,479 @@
}
+=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;
+ '';
+
+}
+
+=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 $FS::cust_main::Billing_Realtime::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;
+
+ my $check_freq = $opt{'check_freq'} || '1d';
+
+ foreach my $eventtable ( @eventtable ) {
+
+ my @objects;
+ if ( $opt{'objects'} ) {
+
+ @objects = @{ $opt{'objects'} };
+
+ } else {
+
+ #my @objects = $self->$eventtable(); # sub cust_main { @{ [ $self ] }; }
+ if ( $eventtable eq 'cust_main' ) {
+ @objects = ( $self );
+ } else {
+
+ my $cm_join =
+ "LEFT JOIN cust_main USING ( custnum )";
+
+ #some false laziness w/Cron::bill bill_where
+
+ my $join = FS::part_event_condition->join_conditions_sql( $eventtable);
+ my $where = FS::part_event_condition->where_conditions_sql($eventtable,
+ 'time'=>$opt{'time'},
+ );
+ $where = $where ? "AND $where" : '';
+
+ my $are_part_event =
+ "EXISTS ( SELECT 1 FROM part_event $join
+ WHERE check_freq = '$check_freq'
+ AND eventtable = '$eventtable'
+ AND ( disabled = '' OR disabled IS NULL )
+ $where
+ )
+ ";
+ #eofalse
+
+ @objects = $self->$eventtable(
+ 'addl_from' => $cm_join,
+ 'extra_sql' => " AND $are_part_event",
+ );
+ }
+
+ }
+
+ 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' => $check_freq,
+ '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 apply_payments_and_credits [ OPTION => VALUE ... ]
More information about the freeside-commits
mailing list