-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 BILLING METHODS
-
-Documentation on realtime billing methods has been moved to
-L<FS::cust_main::Billing_Realtime>.
-
-=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 batch_card OPTION => VALUE...
-
-Adds a payment for this invoice to the pending credit card batch (see
-L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
-runs the payment using a realtime gateway.
-
-=cut
-
-sub batch_card {
- my ($self, %options) = @_;
-
- my $amount;
- if (exists($options{amount})) {
- $amount = $options{amount};
- }else{
- $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
- }
- return '' unless $amount > 0;
-
- my $invnum = delete $options{invnum};
- my $payby = $options{invnum} || $self->payby; #dubious
-
- if ($options{'realtime'}) {
- return $self->realtime_bop( FS::payby->payby2bop($self->payby),
- $amount,
- %options,
- );
- }
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- #this needs to handle mysql as well as Pg, like svc_acct.pm
- #(make it into a common function if folks need to do batching with mysql)
- $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
- or return "Cannot lock pay_batch: " . $dbh->errstr;
-
- my %pay_batch = (
- 'status' => 'O',
- 'payby' => FS::payby->payby2payment($payby),
- );
-
- my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
-
- unless ( $pay_batch ) {
- $pay_batch = new FS::pay_batch \%pay_batch;
- my $error = $pay_batch->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die "error creating new batch: $error\n";
- }
- }
-
- my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
- 'batchnum' => $pay_batch->batchnum,
- 'custnum' => $self->custnum,
- } );
-
- foreach (qw( address1 address2 city state zip country payby payinfo paydate
- payname )) {
- $options{$_} = '' unless exists($options{$_});
- }