[freeside-commits] freeside/FS/FS Schema.pm, 1.27, 1.28 Setup.pm,
1.4, 1.5 cust_bill.pm, 1.151, 1.152 cust_bill_event.pm, 1.12,
1.13 cust_bill_pay_batch.pm, NONE, 1.1 cust_main.pm, 1.242,
1.243 cust_pay_batch.pm, 1.13, 1.14 part_bill_event.pm, 1.23,
1.24 payby.pm, 1.4, 1.5
Jeff Finucane,420,,
jeff at wavetail.420.am
Sat Aug 26 16:15:14 PDT 2006
Update of /home/cvs/cvsroot/freeside/FS/FS
In directory wavetail:/tmp/cvs-serv28724/FS/FS
Modified Files:
Schema.pm Setup.pm cust_bill.pm cust_bill_event.pm
cust_main.pm cust_pay_batch.pm part_bill_event.pm payby.pm
Added Files:
cust_bill_pay_batch.pm
Log Message:
batch refactor continued
Index: part_bill_event.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/part_bill_event.pm,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- part_bill_event.pm 9 Aug 2006 06:43:01 -0000 1.23
+++ part_bill_event.pm 26 Aug 2006 23:15:12 -0000 1.24
@@ -1,11 +1,13 @@
package FS::part_bill_event;
use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
+use vars qw( @ISA $DEBUG @EXPORT_OK );
+use FS::Record qw( dbh qsearch qsearchs );
use FS::Conf;
- at ISA = qw(FS::Record);
+ at ISA = qw( FS::Record );
+ at EXPORT_OK = qw( due_events );
+$DEBUG = 0;
=head1 NAME
@@ -26,6 +28,13 @@
$error = $record->check;
+ $error = $record->do_event( $direct_object );
+
+ @events = due_events ( { 'record' => $event_triggering_record,
+ 'payby' => $payby,
+ 'event_time => $_date,
+ 'extra_sql => $extra } );
+
=head1 DESCRIPTION
An FS::part_bill_event object represents an invoice event definition -
@@ -124,7 +133,7 @@
$c =~ /^\s*\$cust_main\->(suspend|cancel|invoicing_list_addpost|bill|collect)\(\);\s*("";)?\s*$/
- or $c =~ /^\s*\$cust_bill\->(comp|realtime_(card|ach|lec)|batch_card|send)\(\);\s*$/
+ or $c =~ /^\s*\$cust_bill\->(comp|realtime_(card|ach|lec)|batch_card|send)\((%options)*\);\s*$/
or $c =~ /^\s*\$cust_bill\->send(_if_newest)?\(\'[\w\-\s]+\'\s*(,\s*(\d+|\[\s*\d+(,\s*\d+)*\s*\])\s*,\s*'[\w\@\.\-\+]*'\s*)?\);\s*$/
@@ -197,6 +206,103 @@
}
}
+=item due_events
+
+Returns the list of events due, if any, or false if there is none.
+Requires record and payby, but event_time and extra_sql are optional.
+
+=cut
+
+sub due_events {
+ my ($record, $payby, $event_time, $extra_sql) = @_;
+ my $interval = 0;
+ if ($record->_date){
+ $event_time = time unless $event_time;
+ $interval = $event_time - $record->_date;
+ }
+ sort { $a->seconds <=> $b->seconds
+ || $a->weight <=> $b->weight
+ || $a->eventpart <=> $b->eventpart }
+ grep { $_->seconds <= ( $interval )
+ && ! qsearch( 'cust_bill_event', {
+ 'invnum' => $record->get($record->dbdef_table->primary_key),
+ 'eventpart' => $_->eventpart,
+ 'status' => 'done',
+ } )
+ }
+ qsearch( {
+ 'table' => 'part_bill_event',
+ 'hashref' => { 'payby' => $payby,
+ 'disabled' => '', },
+ 'extra_sql' => $extra_sql,
+ } );
+
+
+}
+
+=item do_event
+
+Performs the event and returns any errors that occur.
+Requires a record on which to perform the event.
+Should only be performed inside a transaction.
+
+=cut
+
+sub do_event {
+ my ($self, $object, %options) = @_;
+ warn " calling event (". $self->eventcode. ") for " . $object->table . " " ,
+ $object->get($object->dbdef_table->primary_key) . "\n" if $DEBUG > 1;
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+
+ # for "callback" -- heh
+ my $cust_main = $object->cust_main;
+ my $cust_bill;
+ if ($object->table eq 'cust_bill'){
+ $cust_bill = $object;
+ }
+ my $cust_pay_batch;
+ if ($object->table eq 'cust_pay_batch'){
+ $cust_pay_batch = $object;
+ }
+
+ my $error;
+ {
+ local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
+ $error = eval $self->eventcode;
+ }
+
+ my $status = '';
+ my $statustext = '';
+ if ( $@ ) {
+ $status = 'failed';
+ $statustext = $@;
+ } elsif ( $error ) {
+ $status = 'done';
+ $statustext = $error;
+ } else {
+ $status = 'done';
+ }
+
+ #add cust_bill_event
+ my $cust_bill_event = new FS::cust_bill_event {
+# 'invnum' => $object->get($object->dbdef_table->primary_key),
+ 'invnum' => $object->invnum,
+ 'eventpart' => $self->eventpart,
+ '_date' => time,
+ 'status' => $status,
+ 'statustext' => $statustext,
+ };
+ $error = $cust_bill_event->insert;
+ if ( $error ) {
+ my $e = 'WARNING: Event run but database not updated - '.
+ 'error inserting cust_bill_event, invnum #'. $object->invnum .
+ ', eventpart '. $self->eventpart.": $error";
+ warn $e;
+ return $e;
+ }
+ '';
+}
=back
--- NEW FILE: cust_bill_pay_batch.pm ---
package FS::cust_bill_pay_batch;
use strict;
use vars qw( @ISA );
use FS::Record qw( qsearch qsearchs );
@ISA = qw(FS::Record);
=head1 NAME
FS::cust_bill_pay_batch - Object methods for cust_bill_pay_batch records
=head1 SYNOPSIS
use FS::cust_bill_pay_batch;
$record = new FS::cust_bill_pay_batch \%hash;
$record = new FS::cust_bill_pay_batch { 'column' => 'value' };
$error = $record->insert;
$error = $new_record->replace($old_record);
$error = $record->delete;
$error = $record->check;
=head1 DESCRIPTION
An FS::cust_bill_pay_batch object represents a relationship between a
customer's bill and a batch. FS::cust_bill_pay_batch inherits from
FS::Record. The following fields are currently supported:
=over 4
=item billpaynum - primary key
=item invnum - customer's bill (invoice)
=item paybatchnum - entry in cust_pay_batch table
=item amount -
=item _date -
=back
=head1 METHODS
=over 4
=item new HASHREF
Creates a new record. To add the record to the database, see L<"insert">.
Note that this stores the hash reference, not a distinct copy of the hash it
points to. You can ask the object for a copy with the I<hash> method.
=cut
sub table { 'cust_bill_pay_batch'; }
=item insert
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
=cut
=item delete
Delete this record from the database.
=cut
=item replace OLD_RECORD
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
=cut
=item check
Checks all fields to make sure this is a valid example. If there is
an error, returns the error, otherwise returns false. Called by the insert
and replace methods.
=cut
sub check {
my $self = shift;
my $error =
$self->ut_numbern('billpaynum')
|| $self->ut_number('invnum')
|| $self->ut_number('paybatchnum')
|| $self->ut_money('amount')
|| $self->ut_numbern('_date')
;
return $error if $error;
$self->SUPER::check;
}
=back
=head1 BUGS
Just hangs there.
=head1 SEE ALSO
L<FS::Record>, schema.html from the base documentation.
=cut
1;
Index: payby.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/payby.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- payby.pm 9 Aug 2006 06:43:01 -0000 1.4
+++ payby.pm 26 Aug 2006 23:15:12 -0000 1.5
@@ -1,9 +1,10 @@
package FS::payby;
use strict;
-use vars qw(%hash);
+use vars qw(%hash @EXPORT_OK);
use Tie::IxHash;
+
=head1 NAME
FS::payby - Object methods for payment type records
@@ -106,6 +107,11 @@
map { $_ => $hash{$_}->{longname} } $self->payby;
}
+sub payby2bop {
+ { 'CARD' => 'CC'.
+ 'CHEK' => 'ECHECK',};
+}
+
sub cust_payby {
my $self = shift;
grep { ! exists $hash{$_}->{cust_main} } $self->payby;
@@ -116,6 +122,27 @@
map { $_ => $hash{$_}->{longname} } $self->cust_payby;
}
+sub payinfo_check{
+ my($payby, $payinforef) = @_;
+
+ if ($payby eq 'CARD') {
+ $$payinforef =~ s/\D//g;
+ if ($$payinforef){
+ $$payinforef =~ /^(\d{13,16})$/
+ or return "Illegal (mistyped?) credit card number (payinfo)";
+ $$payinforef = $1;
+ validate($$payinforef) or return "Illegal credit card number";
+ return "Unknown card type" if cardype($$payinforef) eq "Unknown";
+ } else {
+ $$payinforef="N/A";
+ }
+ } else {
+ $$payinforef =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/
+ or return "Illegal text (payinfo)";
+ $$payinforef = $1;
+ }
+}
+
=back
=head1 BUGS
Index: cust_bill.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_bill.pm,v
retrieving revision 1.151
retrieving revision 1.152
diff -u -d -r1.151 -r1.152
--- cust_bill.pm 21 Aug 2006 23:01:43 -0000 1.151
+++ cust_bill.pm 26 Aug 2006 23:15:11 -0000 1.152
@@ -1,7 +1,7 @@
package FS::cust_bill;
use strict;
-use vars qw( @ISA $DEBUG $conf $money_char );
+use vars qw( @ISA $DEBUG $me $conf $money_char );
use vars qw( $invoice_lines @buf ); #yuck
use Fcntl qw(:flock); #for spool_csv
use IPC::Run3;
@@ -26,11 +26,14 @@
use FS::cust_bill_event;
use FS::part_pkg;
use FS::cust_bill_pay;
+use FS::cust_bill_pay_batch;
use FS::part_bill_event;
+use FS::payby qw( payby2bop );
@ISA = qw( FS::cust_main_Mixin FS::Record );
$DEBUG = 0;
+$me = '[FS::cust_bill]';
#ask FS::UID to run this stuff for us later
FS::UID->install_callback( sub {
@@ -1308,12 +1311,18 @@
=cut
sub batch_card {
- my $self = shift;
+ my ($self, %options) = @_;
my $cust_main = $self->cust_main;
my $amount = sprintf("%.2f", $cust_main->balance - $cust_main->in_transit_payments);
return '' unless $amount > 0;
+ if ($options{'realtime'}) {
+ return $cust_main->realtime_bop ( $FS::payby::payby2bop->{$cust_main->payby}, $amount,
+ %options,
+ );
+ }
+
my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
@@ -1369,6 +1378,30 @@
die $error;
}
+ my $unapplied = $cust_main->total_credited + $cust_main->total_unapplied_payments + $cust_main->in_transit_payments;
+ foreach my $cust_bill ($cust_main->open_cust_bill) {
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
+ 'invnum' => $cust_bill->invnum,
+ 'paybatchnum' => $cust_pay_batch->paybatchnum,
+ 'amount' => $cust_bill->owed,
+ '_date' => time,
+ };
+ if ($unapplied >= $cust_bill_pay_batch->amount){
+ $unapplied -= $cust_bill_pay_batch->amount;
+ next;
+ }else{
+ $cust_bill_pay_batch->amount(sprintf ( "%.2f",
+ $cust_bill_pay_batch->amount - $unapplied ));
+ $unapplied = 0;
+ }
+ $error = $cust_bill_pay_batch->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ die $error;
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
}
Index: Setup.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Setup.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- Setup.pm 9 Aug 2006 06:43:01 -0000 1.4
+++ Setup.pm 26 Aug 2006 23:15:11 -0000 1.5
@@ -143,7 +143,7 @@
{ 'payby' => 'CARD',
'event' => 'Batch card',
'seconds' => 0,
- 'eventcode' => '$cust_bill->batch_card();',
+ 'eventcode' => '$cust_bill->batch_card(%options);',
'weight' => 40,
'plan' => 'batch-card',
},
@@ -175,6 +175,13 @@
'weight' => 40,
'plan' => 'suspend',
},
+ { 'payby' => 'DCLN',
+ 'event' => 'Retriable',
+ 'seconds' => 0,
+ 'eventcode' => '$cust_bill_event->retriable();',
+ 'weight' => 60,
+ 'plan' => 'retriable',
+ },
],
#you must create a service definition. An example of a service definition
Index: cust_main.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main.pm,v
retrieving revision 1.242
retrieving revision 1.243
diff -u -d -r1.242 -r1.243
--- cust_main.pm 21 Aug 2006 17:46:44 -0000 1.242
+++ cust_main.pm 26 Aug 2006 23:15:12 -0000 1.243
@@ -42,7 +42,7 @@
use FS::prepay_credit;
use FS::queue;
use FS::part_pkg;
-use FS::part_bill_event;
+use FS::part_bill_event qw(due_events);
use FS::cust_bill_event;
use FS::cust_tax_exempt;
use FS::cust_tax_exempt_pkg;
@@ -2251,79 +2251,28 @@
warn " invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
if $DEBUG > 1;
- foreach my $part_bill_event (
- sort { $a->seconds <=> $b->seconds
- || $a->weight <=> $b->weight
- || $a->eventpart <=> $b->eventpart }
- grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
- && ! qsearch( 'cust_bill_event', {
- 'invnum' => $cust_bill->invnum,
- 'eventpart' => $_->eventpart,
- 'status' => 'done',
- } )
- }
- qsearch( {
- 'table' => 'part_bill_event',
- 'hashref' => { 'payby' => (exists($options{'payby'})
- ? $options{'payby'}
- : $self->payby
- ),
- 'disabled' => '', },
- 'extra_sql' => $extra_sql,
- } )
- ) {
+ foreach my $part_bill_event ( due_events ( $cust_bill,
+ exists($options{'payby'})
+ ? $options{'payby'}
+ : $self->payby,
+ $invoice_time,
+ $extra_sql ) ) {
last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
|| $self->balance <= 0; # or if balance<=0
- warn " calling invoice event (". $part_bill_event->eventcode. ")\n"
- if $DEBUG > 1;
- my $cust_main = $self; #for callback
-
- my $error;
{
local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
- local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
- $error = eval $part_bill_event->eventcode;
- }
-
- my $status = '';
- my $statustext = '';
- if ( $@ ) {
- $status = 'failed';
- $statustext = $@;
- } elsif ( $error ) {
- $status = 'done';
- $statustext = $error;
- } else {
- $status = 'done'
- }
-
- #add cust_bill_event
- my $cust_bill_event = new FS::cust_bill_event {
- 'invnum' => $cust_bill->invnum,
- 'eventpart' => $part_bill_event->eventpart,
- #'_date' => $invoice_time,
- '_date' => time,
- 'status' => $status,
- 'statustext' => $statustext,
- };
- $error = $cust_bill_event->insert;
- if ( $error ) {
- #$dbh->rollback if $oldAutoCommit;
- #return "error: $error";
+ warn " do_event " . $cust_bill . " ". (%options) . "\n"
+ if $DEBUG > 1;
- # gah, even with transactions.
- $dbh->commit if $oldAutoCommit; #well.
- my $e = 'WARNING: Event run but database not updated - '.
- 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
- ', eventpart '. $part_bill_event->eventpart.
- ": $error";
- warn $e;
- return $e;
+ if (my $error = $part_bill_event->do_event($cust_bill, %options)) {
+ # gah, even with transactions.
+ $dbh->commit if $oldAutoCommit; #well.
+ return $error;
+ }
}
-
}
}
@@ -2335,9 +2284,10 @@
=item retry_realtime
-Schedules realtime 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.
+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 each of this customer's open invoices, changes
the status of the first "done" (with statustext error) realtime processing
@@ -2368,7 +2318,7 @@
grep {
#$_->part_bill_event->plan eq 'realtime-card'
$_->part_bill_event->eventcode =~
- /\$cust_bill\->realtime_(card|ach|lec)/
+ /\$cust_bill\->(batch|realtime)_(card|ach|lec)/
&& $_->status eq 'done'
&& $_->statustext
}
Index: cust_bill_event.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_bill_event.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- cust_bill_event.pm 14 Jul 2005 10:52:46 -0000 1.12
+++ cust_bill_event.pm 26 Aug 2006 23:15:11 -0000 1.13
@@ -126,12 +126,13 @@
|| $self->ut_textn('statustext')
;
+ return "Unknown eventpart ". $self->eventpart
+ unless my $part_bill_event =
+ qsearchs( 'part_bill_event' ,{ 'eventpart' => $self->eventpart } );
+
return "Unknown invnum ". $self->invnum
unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } );
- return "Unknown eventpart ". $self->eventpart
- unless qsearchs( 'part_bill_event' ,{ 'eventpart' => $self->eventpart } );
-
$self->SUPER::check;
}
@@ -173,6 +174,21 @@
$self->replace($old);
}
+=item retryable
+
+Changes the statustext of this event to B<retriable>, rendering it
+retriable (should retry be called).
+
+=cut
+
+sub retriable {
+ my $self = shift;
+ return '' unless $self->status eq 'done';
+ my $old = ref($self)->new( { $self->hash } );
+ $self->statustext('retriable');
+ $self->replace($old);
+}
+
=back
=head1 SUBROUTINES
Index: Schema.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Schema.pm,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- Schema.pm 26 Aug 2006 14:44:06 -0000 1.27
+++ Schema.pm 26 Aug 2006 23:15:11 -0000 1.28
@@ -545,6 +545,19 @@
'index' => [ [ 'paynum' ], [ 'invnum' ] ],
},
+ 'cust_bill_pay_batch' => {
+ 'columns' => [
+ 'billpaynum', 'serial', '', '', '', '',
+ 'invnum', 'int', '', '', '', '',
+ 'paybatchnum', 'int', '', '', '', '',
+ 'amount', @money_type, '', '',
+ '_date', @date_type, '', '',
+ ],
+ 'primary_key' => 'billpaynum',
+ 'unique' => [],
+ 'index' => [ [ 'paybatchnum' ], [ 'invnum' ] ],
+ },
+
'cust_bill_pay_pkg' => {
'columns' => [
'billpaypkgnum', 'serial', '', '', '', '',
Index: cust_pay_batch.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pay_batch.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- cust_pay_batch.pm 9 Aug 2006 06:43:01 -0000 1.13
+++ cust_pay_batch.pm 26 Aug 2006 23:15:12 -0000 1.14
@@ -3,7 +3,8 @@
use strict;
use vars qw( @ISA $DEBUG );
use FS::Record qw(dbh qsearch qsearchs);
-use Business::CreditCard;
+use FS::part_bill_event qw(due_events);
+use Business::CreditCard 0.28;
@ISA = qw( FS::Record );
@@ -31,6 +32,8 @@
$error = $record->check;
+ $error = $record->retriable;
+
=head1 DESCRIPTION
An FS::cust_pay_batch object represents a credit card transaction ready to be
@@ -143,19 +146,8 @@
or return "Illegal payby";
$self->payby($1);
- # FIXME
- # there is no point in false laziness here
- # we will effectively set "check_payinfo to 0"
- # we can change that when we finish the refactor
-
- #my $cardnum = $self->cardnum;
- #$cardnum =~ s/\D//g;
- #$cardnum =~ /^(\d{13,16})$/
- # or return "Illegal credit card number";
- #$cardnum = $1;
- #$self->cardnum($cardnum);
- #validate($cardnum) or return "Illegal credit card number";
- #return "Unknown card type" if cardtype($cardnum) eq "Unknown";
+ #$error = FS::payby::payinfo_check($self->payby, \$self->payinfo);
+ #return $error if $error;
if ( $self->exp eq '' ) {
return "Expiration date required"
@@ -212,6 +204,54 @@
qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
}
+=item retriable
+
+Marks the corresponding event (see L<FS::cust_bill_event>) for this batched
+credit card payment as retriable. Useful if the corresponding financial
+institution account was declined for temporary reasons and/or a manual
+retry is desired.
+
+Implementation details: For the named customer's invoice, changes the
+statustext of the 'done' (without statustext) event to 'retriable.'
+
+=cut
+
+sub retriable {
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE'; #Hmm
+ 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;
+
+ my $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
+ or return "event $self->eventnum references nonexistant invoice $self->invnum";
+
+ warn "cust_pay_batch->retriable working with self of " . $self->paybatchnum . " and invnum of " . $self->invnum;
+ my @cust_bill_event =
+ sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
+ grep {
+ $_->part_bill_event->eventcode =~ /\$cust_bill->batch_card/
+ && $_->status eq 'done'
+ && ! $_->statustext
+ }
+ $cust_bill->cust_bill_event;
+ # complain loudly if scalar(@cust_bill_event) > 1 ?
+ my $error = $cust_bill_event[0]->retriable;
+ if ($error ) {
+ # gah, even with transactions.
+ $dbh->commit if $oldAutoCommit; #well.
+ return "error marking invoice event retriable: $error";
+ }
+ '';
+}
+
=back
=head1 SUBROUTINES
@@ -465,70 +505,19 @@
$new_cust_pay_batch->status('Declined');
- #this should be configurable... if anybody else ever uses batches
- # $cust_pay_batch->cust_main->suspend;
-
- foreach my $part_bill_event (
- sort { $a->seconds <=> $b->seconds
- || $a->weight <=> $b->weight
- || $a->eventpart <=> $b->eventpart }
- grep { ! qsearch( 'cust_bill_event', {
- 'invnum' => $cust_pay_batch->invnum,
- 'eventpart' => $_->eventpart,
- 'status' => 'done',
- } )
- }
- qsearch( {
- 'table' => 'part_bill_event',
- 'hashref' => { 'payby' => 'DCLN',
- 'disabled' => '', },
- } )
- ) {
+ foreach my $part_bill_event ( due_events ( $new_cust_pay_batch,
+ 'DCLN',
+ '',
+ '') ) {
# don't run subsequent events if balance<=0
last if $cust_pay_batch->cust_main->balance <= 0;
- warn " calling invoice event (". $part_bill_event->eventcode. ")\n"
- if $DEBUG > 1;
- my $cust_main = $cust_pay_batch->cust_main; #for callback
-
- my $error;
- {
- local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
- $error = eval $part_bill_event->eventcode;
- }
-
- my $status = '';
- my $statustext = '';
- if ( $@ ) {
- $status = 'failed';
- $statustext = $@;
- } elsif ( $error ) {
- $status = 'done';
- $statustext = $error;
- } else {
- $status = 'done'
- }
-
- #add cust_bill_event
- my $cust_bill_event = new FS::cust_bill_event {
- 'invnum' => $cust_pay_batch->invnum,
- 'eventpart' => $part_bill_event->eventpart,
- '_date' => time,
- 'status' => $status,
- 'statustext' => $statustext,
- };
- $error = $cust_bill_event->insert;
- if ( $error ) {
+ if (my $error = $part_bill_event->do_event($new_cust_pay_batch)) {
# gah, even with transactions.
$dbh->commit if $oldAutoCommit; #well.
- my $e = 'WARNING: Event run but database not updated - '.
- 'error inserting cust_bill_event, invnum #'. $cust_pay_batch->invnum.
- ', eventpart '. $part_bill_event->eventpart.
- ": $error";
- warn $e;
- return $e;
- }
+ return $error;
+ }
}
More information about the freeside-commits
mailing list