package FS::cust_event; use base qw( FS::cust_main_Mixin FS::Record ); use strict; use vars qw( $DEBUG $me ); use Carp qw( croak confess ); use FS::Record qw( qsearch qsearchs dbdef ); #for cust_X use FS::cust_main; use FS::cust_pkg; use FS::cust_bill; use FS::cust_pay; use FS::svc_acct; $DEBUG = 0; $me = '[FS::cust_event]'; =head1 NAME FS::cust_event - Object methods for cust_event records =head1 SYNOPSIS use FS::cust_event; $record = new FS::cust_event \%hash; $record = new FS::cust_event { 'column' => 'value' }; $error = $record->insert; $error = $new_record->replace($old_record); $error = $record->delete; $error = $record->check; =head1 DESCRIPTION An FS::cust_event object represents an completed event. FS::cust_event inherits from FS::Record. The following fields are currently supported: =over 4 =item eventnum - primary key =item eventpart - event definition (see L) =item tablenum - customer, package or invoice, depending on the value of part_event.eventtable (see L, L, and L) =item _date - specified as a UNIX timestamp; see L. Also see L and L for conversion functions. =item status - event status: B, B, B or B. Note: B indicates the event is complete and should not be retried (statustext may still be set to an optional message), while B indicates the event failed and should be retried. =item statustext - additional status detail (i.e. error or progress message) =item no_action - 'Y' if the event action wasn't performed. Some actions contain an internal check to see if the action is going to be impossible (for example, emailing a notice to a customer who has no email address), and if so, won't attempt the action. It shouldn't be reported as a failure because there's no need to retry it. However, the action should set no_action = 'Y' so that there's a record. =back =head1 METHODS =over 4 =item new HASHREF Creates a new completed invoice event. To add the compelted invoice event 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 method. =cut # the new method can be inherited from FS::Record, if a table method is defined sub table { 'cust_event'; } sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum } sub cust_unlinked_msg { my $self = shift; "WARNING: can't find cust_main.custnum ". $self->custnum; #' (cust_bill.invnum '. $self->invnum. ')'; } sub custnum { my $self = shift; $self->cust_main_custnum(@_) || $self->SUPER::custnum(@_); } =item insert Adds this record to the database. If there is an error, returns the error, otherwise returns false. =cut # the insert method can be inherited from FS::Record =item delete Delete this record from the database. =cut # the delete method can be inherited from FS::Record =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 # the replace method can be inherited from FS::Record =item check Checks all fields to make sure this is a valid completed invoice event. If there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. =cut # the check method should currently be supplied - FS::Record contains some # data checking routines sub check { my $self = shift; my $error = $self->ut_numbern('eventnum') || $self->ut_foreign_key('eventpart', 'part_event', 'eventpart') ; return $error if $error; my $eventtable = $self->part_event->eventtable; my $dbdef_eventtable = dbdef->table( $eventtable ); $error = $self->ut_foreign_key( 'tablenum', $eventtable, $dbdef_eventtable->primary_key ) || $self->ut_number('_date') || $self->ut_enum('status', [qw( new locked done failed initial)]) || $self->ut_anything('statustext') || $self->ut_flag('no_action') ; return $error if $error; $self->SUPER::check; } =item part_event Returns the event definition (see L) for this completed event. =item cust_X Returns the customer, package, invoice or batched payment (see L, L, L or L) for this completed invoice event. =cut sub cust_bill { croak "FS::cust_event::cust_bill called"; } sub cust_X { my $self = shift; my $eventtable = $self->part_event->eventtable; my $dbdef_table = dbdef->table( $eventtable ); my $primary_key = $dbdef_table->primary_key; qsearchs( $eventtable, { $primary_key => $self->tablenum } ); } =item test_conditions [ OPTION => VALUE ... ] Tests conditions for this event, returns true if all conditions are satisfied, false otherwise. =cut sub test_conditions { my( $self, %opt ) = @_; my $part_event = $self->part_event; my $object = $self->cust_X; my @conditions = $part_event->part_event_condition; $opt{'cust_event'} = $self; $opt{'time'} = $self->_date or die "test_conditions called without cust_event._date\n"; # this MUST be set, or all hell breaks loose in event conditions. # it MUST be in the same time as in the cust_event object, or # future time-dependent events will trigger incorrectly. #no unsatisfied conditions #! grep ! $_->condition( $object, %opt ), @conditions; my @unsatisfied = grep ! $_->condition( $object, %opt ), @conditions; if ( $opt{'stats_hashref'} ) { foreach my $unsat (@unsatisfied) { $opt{'stats_hashref'}->{$unsat->conditionname}++; } } ! @unsatisfied; } =item do_event Runs the event action. =cut sub do_event { my $self = shift; my %opt = @_; # currently only 'time' my $time = $opt{'time'} || time; my $part_event = $self->part_event; my $object = $self->cust_X; my $obj_pkey = $object->primary_key; my $for = "for ". $object->table. " ". $object->$obj_pkey(); warn "running cust_event ". $self->eventnum. " (". $part_event->action. ") $for\n" if $DEBUG; my $error; { local $SIG{__DIE__}; # don't want Mason __DIE__ handler active $error = eval { $part_event->do_action($object, $self); }; } my $status = ''; my $statustext = ''; if ( $@ ) { $status = 'failed'; #$statustext = $@; $statustext = "Error running ". $part_event->action. " action: $@"; } elsif ( $error ) { $status = 'done'; if ( $error eq 'N/A' ) { # archaic way to indicate no-op completion of spool_csv (and maybe # other events)? $self->no_action('Y'); } else { $statustext = $error; } } else { $status = 'done'; } #replace or add myself $self->_date($time); $self->status($status); $self->statustext($statustext); $error = $self->eventnum ? $self->replace : $self->insert; if ( $error ) { #this is why we need that locked state... my $e = 'WARNING: Event run but database not updated - '. 'error replacing or inserting cust_event '. $self->eventnum. " $for: $error\n"; warn $e; return $e; } ''; } =item retry Changes the status of this event from B to B, allowing it to be retried. =cut sub retry { my $self = shift; return '' unless $self->status eq 'done'; my $old = ref($self)->new( { $self->hash } ); $self->status('failed'); $self->replace($old); } #=item retryable # #Changes the statustext of this event to B, rendering it #retriable (should retry be called). # #=cut sub retriable { confess "cust_event->retriable called"; my $self = shift; return '' unless $self->status eq 'done'; my $old = ref($self)->new( { $self->hash } ); $self->statustext('retriable'); $self->replace($old); } =item join_sql =cut sub join_sql { #my $class = shift; " JOIN part_event USING ( eventpart ) LEFT JOIN cust_bill ON ( eventtable = 'cust_bill' AND tablenum = cust_bill.invnum ) LEFT JOIN cust_pkg ON ( eventtable = 'cust_pkg' AND tablenum = cust_pkg.pkgnum ) LEFT JOIN cust_pay ON ( eventtable = 'cust_pay' AND tablenum = cust_pay.paynum ) LEFT JOIN cust_pay_batch ON ( eventtable = 'cust_pay_batch' AND tablenum = cust_pay_batch.paybatchnum ) LEFT JOIN cust_statement ON ( eventtable = 'cust_statement' AND tablenum = cust_statement.statementnum ) LEFT JOIN cust_svc ON ( eventtable = 'svc_acct' AND tablenum = cust_svc.svcnum ) LEFT JOIN cust_pkg AS cust_pkg_for_svc ON ( cust_svc.pkgnum = cust_pkg_for_svc.pkgnum ) LEFT JOIN cust_main ON ( ( eventtable = 'cust_main' AND tablenum = cust_main.custnum ) OR ( eventtable = 'cust_bill' AND cust_bill.custnum = cust_main.custnum ) OR ( eventtable = 'cust_pkg' AND cust_pkg.custnum = cust_main.custnum ) OR ( eventtable = 'cust_pay' AND cust_pay.custnum = cust_main.custnum ) OR ( eventtable = 'svc_acct' AND cust_pkg_for_svc.custnum = cust_main.custnum ) ) "; } =item search_sql_where HASHREF Class method which returns an SQL WHERE fragment to search for parameters specified in HASHREF. Valid parameters are =over 4 =item agentnum =item custnum =item invnum =item pkgnum =item svcnum =item failed =item beginning =item ending =back =cut #Note: validates all passed-in data; i.e. safe to use with unchecked CGI params. #sub sub search_sql_where { my($class, $param) = @_; if ( $DEBUG ) { warn "$me search_sql_where called with params: \n". join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n"; } my @search = $class->cust_search_sql($param); #eventpart my @eventpart = ref($param->{'eventpart'}) ? @{ $param->{'eventpart'} } : split(',', $param->{'eventpart'}); @eventpart = grep /^(\d+)$/, @eventpart; if ( @eventpart ) { push @search, 'eventpart IN ('. join(',', @eventpart). ')'; } if ( $param->{'beginning'} =~ /^(\d+)$/ ) { push @search, "cust_event._date >= $1"; } if ( $param->{'ending'} =~ /^(\d+)$/ ) { push @search, "cust_event._date <= $1"; } #if ( $param->{'failed'} ) { # push @search, "statustext != ''", # "statustext IS NOT NULL", # "statustext != 'N/A'"; #} # huh? my @event_status = ref($param->{'event_status'}) ? @{ $param->{'event_status'} } : split(',', $param->{'event_status'}); if ( @event_status ) { my @status; my ($done_Y, $done_N, $done_S); # done_Y: action was taken # done_N: action was not taken # done_S: status message returned foreach (@event_status) { if ($_ eq 'done_Y') { $done_Y = 1; } elsif ( $_ eq 'done_N' ) { $done_N = 1; } elsif ( $_ eq 'done_S' ) { $done_S = 1; } else { push @status, $_; } } if ( $done_Y or $done_N or $done_S ) { push @status, 'done'; } if ( @status ) { push @search, "cust_event.status IN(" . join(',', map "'$_'", @status) . ')'; } # done_S status should include only those where statustext is not null, # and done_Y should include only those where it is. if ( $done_Y and $done_N and $done_S ) { # then not necessary } else { my @done_status; if ( $done_Y ) { push @done_status, "(cust_event.no_action IS NULL AND cust_event.statustext IS NULL)"; } if ( $done_N ) { push @done_status, "(cust_event.no_action = 'Y')"; } if ( $done_S ) { push @done_status, "(cust_event.no_action IS NULL AND cust_event.statustext IS NOT NULL)"; } push @search, join(' OR ', @done_status) if @done_status; } } # event_status # always hide initialization push @search, 'cust_event.status != \'initial\''; if ( $param->{'custnum'} =~ /^(\d+)$/ ) { push @search, "cust_main.custnum = '$1'"; } if ( $param->{'invnum'} =~ /^(\d+)$/ ) { push @search, "part_event.eventtable = 'cust_bill'", "tablenum = '$1'"; } if ( $param->{'pkgnum'} =~ /^(\d+)$/ ) { push @search, "part_event.eventtable = 'cust_pkg'", "tablenum = '$1'"; } if ( $param->{'paynum'} =~ /^(\d+)$/ ) { push @search, "part_event.eventtable = 'cust_pay'", "tablenum = '$1'"; } if ( $param->{'svcnum'} =~ /^(\d+)$/ ) { push @search, "part_event.eventtable = 'svc_acct'", "tablenum = '$1'"; } my $where = 'WHERE '. join(' AND ', @search ); join(' AND ', @search ); } =back =head1 SUBROUTINES =over 4 =item reprint =cut sub process_reprint { process_re_X('print', @_); } =item reemail =cut sub process_reemail { process_re_X('email', @_); } =item refax =cut sub process_refax { process_re_X('fax', @_); } use Data::Dumper; sub process_re_X { my( $method, $job, $param ) = @_; warn Dumper($param) if $DEBUG; re_X( $method, $param, $job, ); } sub re_X { my($method, $param, $job) = @_; my $search_sql = FS::cust_event->search_sql_where($param); #maybe not...? we do want the "re-" action to match the search more closely # # yuck! hardcoded *AND* sequential scans! #my $where = " WHERE action LIKE 'cust_bill_send%' ". # ( $search_sql ? " AND $search_sql" : "" ); my $where = ( $search_sql ? " WHERE $search_sql" : "" ); my @cust_event = qsearch({ 'table' => 'cust_event', 'addl_from' => FS::cust_event->join_sql(), 'hashref' => {}, 'extra_sql' => $where, }); warn "$me re_X found ". scalar(@cust_event). " events\n" if $DEBUG; my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo foreach my $cust_event ( @cust_event ) { my $cust_X = $cust_event->cust_X; # cust_bill next unless $cust_X->can($method); my $part_event = $cust_event->part_event; my $template = $part_event->templatename || $cust_X->agent_template; my $modenum = $part_event->option('modenum') || ''; my $invoice_from = $part_event->option('agent_invoice_from') || ''; $cust_X->set('mode' => $modenum); $cust_X->$method( { template => $template, modenum => $modenum, from => $invoice_from, } ); if ( $job ) { #progressbar foo $num++; if ( time - $min_sec > $last ) { my $error = $job->update_statustext( int( 100 * $num / scalar(@cust_event) ) ); die $error if $error; $last = time; } } } #this doesn't work, but it would be nice #if ( $job ) { #progressbar foo # my $error = $job->update_statustext( # scalar(@cust_event). " invoices re-${method}ed" # ); # die $error if $error; #} } =back =head1 SEE ALSO L, L, L, schema.html from the base documentation. =cut 1;