From 53ea5a72067a9b0ebcd3417692c3884d6f91f74a Mon Sep 17 00:00:00 2001 From: mark Date: Thu, 1 Sep 2011 05:13:09 +0000 Subject: [PATCH] svc_acct events for usage limits, #13202 --- FS/FS/msg_template.pm | 17 +++ FS/FS/part_event.pm | 174 ++++++++++++++++++++++- FS/FS/part_event/Action.pm | 15 ++ FS/FS/part_event/Action/pkg_cancel.pm | 3 +- FS/FS/part_event/Action/pkg_suspend.pm | 6 +- FS/FS/part_event/Action/svc_acct_notice.pm | 51 +++++++ FS/FS/part_event/Condition.pm | 15 ++ FS/FS/part_event/Condition/pkg_status.pm | 4 +- FS/FS/part_event/Condition/svc_acct_overlimit.pm | 57 ++++++++ FS/FS/part_event/Condition/svc_acct_threshold.pm | 63 ++++++++ FS/FS/svc_Common.pm | 10 ++ httemplate/edit/part_event.html | 17 ++- httemplate/edit/process/part_event.html | 13 ++ 13 files changed, 435 insertions(+), 10 deletions(-) create mode 100644 FS/FS/part_event/Action/svc_acct_notice.pm create mode 100644 FS/FS/part_event/Condition/svc_acct_overlimit.pm create mode 100644 FS/FS/part_event/Condition/svc_acct_threshold.pm diff --git a/FS/FS/msg_template.pm b/FS/FS/msg_template.pm index c183477fb..d980ab9e2 100644 --- a/FS/FS/msg_template.pm +++ b/FS/FS/msg_template.pm @@ -430,6 +430,20 @@ sub send { # helper sub for package dates my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' }; +# helper sub for usage-related messages +my $usage_warning = sub { + my $svc = shift; + foreach my $col (qw(seconds upbytes downbytes totalbytes)) { + my $amount = $svc->$col; next if $amount eq ''; + my $method = $col.'_threshold'; + my $threshold = $svc->$method; next if $threshold eq ''; + return [$col, $amount, $threshold] if $amount <= $threshold; + # this only returns the first one that's below threshold, if there are + # several. + } + return ['', '', '']; +}; + #my $conf = new FS::Conf; #return contexts and fill-in values @@ -514,6 +528,9 @@ sub substitutions { domain ), [ password => sub { shift->getfield('_password') } ], + [ column => sub { &$usage_warning(shift)->[0] } ], + [ amount => sub { &$usage_warning(shift)->[1] } ], + [ threshold => sub { &$usage_warning(shift)->[2] } ], ], 'svc_domain' => [qw( svcnum diff --git a/FS/FS/part_event.pm b/FS/FS/part_event.pm index c98c3f87a..8d1e7b0d6 100644 --- a/FS/FS/part_event.pm +++ b/FS/FS/part_event.pm @@ -52,7 +52,7 @@ following fields are currently supported: =item event - event name -=item eventtable - table name against which this event is triggered; currently "cust_bill" (the traditional invoice events), "cust_main" (customer events) or "cust_pkg (package events) (or "cust_statement") +=item eventtable - table name against which this event is triggered: one of "cust_main", "cust_bill", "cust_statement", "cust_pkg", "svc_acct". =item check_freq - how often events of this type are checked; currently "1d" (daily) and "1m" (monthly) are recognized. Note that the apprioriate freeside-daily and/or freeside-monthly cron job needs to be in place. @@ -178,14 +178,16 @@ sub part_event_condition { qsearch( 'part_event_condition', { 'eventpart' => $self->eventpart } ); } -=item new_cust_event OBJECT +=item new_cust_event OBJECT, [ OPTION => VALUE ] Creates a new customer event (see L) for the provided object. +The only option allowed is 'time', to set the "current" time for the event. + =cut sub new_cust_event { - my( $self, $object ) = @_; + my( $self, $object, %opt ) = @_; confess "**** $object is not a ". $self->eventtable if ref($object) ne "FS::". $self->eventtable; @@ -195,7 +197,8 @@ sub new_cust_event { new FS::cust_event { 'eventpart' => $self->eventpart, 'tablenum' => $object->$pkey(), - '_date' => time, #i think we always want the real "now" here. + #'_date' => time, #i think we always want the real "now" here. + '_date' => ($opt{'time'} || time), 'status' => 'new', }; } @@ -252,6 +255,90 @@ sub templatename { } } +=item initialize PARAMS + +Identify all objects eligible for this event and create L +records for each of them, as of the present time, with status "initial". When +combined with conditions that prevent an event from running more than once +(at all or within some period), this will exclude any objects that met the +conditions before the event was created. + +If an L object needs to be initialized, it should be created +in a disabled state to avoid running the event prematurely for any existing +objects. C will enable it once all the cust_event records +have been created. + +This may take some time, so it should be run from the job queue. + +=cut + +sub initialize { + my $self = shift; + my $time = time; # $opt{'time'}? + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $eventpart = $self->eventpart; + $eventpart =~ /^\d+$/ or die "bad eventpart $eventpart"; + my $eventtable = $self->eventtable; + + # find all objects that meet the conditions for this part_event + my $linkage = ''; + # this is the 'object' side of the FROM clause + if ( $eventtable ne 'cust_main' ) { + $linkage = ($self->eventtables_cust_join->{$eventtable} || '') . + ' LEFT JOIN cust_main USING (custnum) ' + } + + # this is the 'event' side + my $join = FS::part_event_condition->join_conditions_sql( $eventtable ); + my $where = FS::part_event_condition->where_conditions_sql( $eventtable, + 'time' => $time + ); + $join = $linkage . + " INNER JOIN part_event ON ( part_event.eventpart = $eventpart ) $join"; + + $where .= ' AND cust_main.agentnum = '.$self->agentnum + if $self->agentnum; + # don't enforce check_freq since this is a special, out-of-order check, + # and don't enforce disabled because we want to do this with the part_event + # disabled. + my @objects = qsearch({ + table => $eventtable, + hashref => {}, + addl_from => $join, + extra_sql => "WHERE $where", + debug => 1, + }); + warn "initialize: ".(scalar @objects) ." $eventtable objects found\n" + if $DEBUG; + my $error = ''; + foreach my $object ( @objects ) { + # test conditions + my $cust_event = $self->new_cust_event($object, 'time' => $time); + next unless $cust_event->test_conditions; + + $cust_event->status('initial'); + $error = $cust_event->insert; + last if $error; + } + if ( !$error and $self->disabled ) { + $self->disabled(''); + $error = $self->replace; + } + if ( $error ) { + $dbh->rollback; + return $error; + } + $dbh->commit if $oldAutoCommit; + return; +} + +=cut + + =back =head1 CLASS METHODS @@ -274,6 +361,7 @@ sub eventtable_labels { 'cust_main' => 'Customer', 'cust_pay_batch' => 'Batch payment', 'cust_statement' => 'Statement', #too general a name here? "Invoice group"? + 'svc_acct' => 'Login service', ; \%hash @@ -312,6 +400,7 @@ sub eventtable_pkey { 'cust_pkg' => 'pkgnum', 'cust_pay_batch' => 'paybatchnum', 'cust_statement' => 'statementnum', + 'svc_acct' => 'svcnum', }; } @@ -337,6 +426,36 @@ sub eventtables_runorder { shift->eventtables; #same for now } +=item eventtables_cust_join + +Returns a hash reference of SQL expressions to join each eventtable to +a table with a 'custnum' field. + +=cut + +sub eventtables_cust_join { + my %hash = ( + 'svc_acct' => 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum)', + ); + \%hash; +} + +=item eventtables_custnum + +Returns a hash reference of SQL expressions for the 'custnum' field when +I is in effect. The default is "$eventtable.custnum". + +=cut + +sub eventtables_custnum { + my %hash = ( + map({ $_, "$_.custnum" } shift->eventtables), + 'svc_acct' => 'cust_pkg.custnum' + ); + \%hash; +} + + =item check_freq_labels Returns a hash reference of labels for check_freq values, @@ -376,6 +495,35 @@ hashrefs with the following keys: =back +=head1 ADDING NEW EVENTTABLES + +To add an eventtable, you must: + +=over 4 + +=item Add the table to "eventtable_labels" (with a label) and to +"eventtable_pkey" (with its primary key). + +=item If the table doesn't have a "custnum" field of its own (such +as a svc_x table), add a suitable join expression to +eventtables_cust_join and an expression for the final custnum field +to eventtables_custnum. + +=item Create a method named FS::cust_main->$eventtable(): a wrapper +around qsearch() to return all records in the new table belonging to +the cust_main object. This method must accept 'addl_from' and +'extra_sql' arguments in the way qsearch() does. For svc_ tables, +wrap the svc_x() method. + +=item Add it to FS::cust_event->join_sql and search_sql_where so that +search/cust_event.html will find it. + +=item Create a UI link/form to search for events linked to objects +in the new eventtable, using search/cust_event.html. Place this +somewhere appropriate to the eventtable. + +=back + See L for more information. =cut @@ -430,12 +578,28 @@ sub all_actions { keys %actions } +=item process_initialize 'eventpart' => EVENTPART + +Job queue wrapper for "initialize". EVENTPART identifies the +L object to initialize. + +=cut + +sub process_initialize { + my %opt = @_; + my $part_event = + qsearchs('part_event', { eventpart => $opt{'eventpart'}}) + or die "eventpart '$opt{eventpart}' not found!\n"; + $part_event->initialize; +} + =back =head1 SEE ALSO L, L, L, -L, L, L, L, +L, L, L, L, +L, schema.html from the base documentation. =cut diff --git a/FS/FS/part_event/Action.pm b/FS/FS/part_event/Action.pm index 094cf7d3a..c0c70b1c3 100644 --- a/FS/FS/part_event/Action.pm +++ b/FS/FS/part_event/Action.pm @@ -192,6 +192,21 @@ sub cust_main { } +=item cust_pkg OBJECT + +Return the package object (L) associated with the provided +object. The object must be either a service (L) or a +package. + +=cut + +sub cust_pkg { + my( $self, $object ) = @_; + $object->isa('FS::cust_pkg') ? $object : + $object->isa('FS::svc_Common') ? $object->cust_svc->cust_pkg : + undef; +} + =item option_label OPTIONNAME Returns the label for the specified option name. diff --git a/FS/FS/part_event/Action/pkg_cancel.pm b/FS/FS/part_event/Action/pkg_cancel.pm index 2bfd35cad..1eeb4a8ff 100644 --- a/FS/FS/part_event/Action/pkg_cancel.pm +++ b/FS/FS/part_event/Action/pkg_cancel.pm @@ -21,7 +21,8 @@ sub option_fields { sub default_weight { 20; } sub do_action { - my( $self, $cust_pkg, $cust_event ) = @_; + my( $self, $object, $cust_event ) = @_; + my $cust_pkg = $self->cust_pkg($object); my $error = $cust_pkg->cancel( 'reason' => $self->option('reasonnum') ); die $error if $error; diff --git a/FS/FS/part_event/Action/pkg_suspend.pm b/FS/FS/part_event/Action/pkg_suspend.pm index e12616c54..23ab13e14 100644 --- a/FS/FS/part_event/Action/pkg_suspend.pm +++ b/FS/FS/part_event/Action/pkg_suspend.pm @@ -6,7 +6,8 @@ use base qw( FS::part_event::Action ); sub description { 'Suspend this package'; } sub eventtable_hashref { - { 'cust_pkg' => 1 }; + { 'cust_pkg' => 1, + 'svc_acct' => 1, }; } sub option_fields { @@ -21,7 +22,8 @@ sub option_fields { sub default_weight { 20; } sub do_action { - my( $self, $cust_pkg, $cust_event ) = @_; + my( $self, $object, $cust_event ) = @_; + my $cust_pkg = $self->cust_pkg($object); my $error = $cust_pkg->suspend( 'reason' => $self->option('reasonnum') ); die $error if $error; diff --git a/FS/FS/part_event/Action/svc_acct_notice.pm b/FS/FS/part_event/Action/svc_acct_notice.pm new file mode 100644 index 000000000..d71a1371a --- /dev/null +++ b/FS/FS/part_event/Action/svc_acct_notice.pm @@ -0,0 +1,51 @@ +package FS::part_event::Action::svc_acct_notice; + +use strict; +use base qw( FS::part_event::Action ); +use FS::Record qw( qsearchs ); +use FS::svc_acct; +use FS::msg_template; + +sub description { 'Email a notice to this account'; } + +sub eventtable_hashref { + { 'svc_acct' => 1 } +}; + +sub option_fields { + ( + 'msgnum' => { 'label' => 'Template', + 'type' => 'select-table', + 'table' => 'msg_template', + 'name_col' => 'msgname', + 'disable_empty' => 1, + }, + ); +} + +sub default_weight { 56; } #? + +sub do_action { + my( $self, $svc_acct ) = @_; + + my $cust_main = $self->cust_main($svc_acct) + or die "No customer found for svcnum ".$svc_acct->svcnum; + # this will never be run for unlinked services, for several reasons + + my $msgnum = $self->option('msgnum'); + + my $msg_template = qsearchs('msg_template', { 'msgnum' => $msgnum } ) + or die "Template $msgnum not found"; + + my $email = $svc_acct->email + or die "No email associated with svcnum ".$svc_acct->svcnum; + + $msg_template->send( + 'cust_main' => $cust_main, + 'object' => $svc_acct, + 'to' => $email, + ); + +} + +1; diff --git a/FS/FS/part_event/Condition.pm b/FS/FS/part_event/Condition.pm index 5c581b498..914256f45 100644 --- a/FS/FS/part_event/Condition.pm +++ b/FS/FS/part_event/Condition.pm @@ -235,6 +235,21 @@ sub cust_main { } +=item cust_pkg OBJECT + +Return the package object (L) associated with the provided +object. The object must be either a service (L) or a +package. + +=cut + +sub cust_pkg { + my( $self, $object ) = @_; + $object->isa('FS::cust_pkg') ? $object : + $object->isa('FS::svc_Common') ? $object->cust_svc->cust_pkg : + undef; +} + =item option_label OPTIONNAME Returns the label for the specified option name. diff --git a/FS/FS/part_event/Condition/pkg_status.pm b/FS/FS/part_event/Condition/pkg_status.pm index 3fb374e9a..0d99f3bbc 100644 --- a/FS/FS/part_event/Condition/pkg_status.pm +++ b/FS/FS/part_event/Condition/pkg_status.pm @@ -13,6 +13,7 @@ sub eventtable_hashref { { 'cust_main' => 0, 'cust_bill' => 0, 'cust_pkg' => 1, + 'svc_acct' => 1, }; } @@ -27,8 +28,9 @@ sub option_fields { } sub condition { - my( $self, $cust_pkg ) = @_; + my( $self, $object ) = @_; + my $cust_pkg = $self->cust_pkg($object); #XXX test my $hashref = $self->option('status') || {}; $hashref->{ $cust_pkg->status }; diff --git a/FS/FS/part_event/Condition/svc_acct_overlimit.pm b/FS/FS/part_event/Condition/svc_acct_overlimit.pm new file mode 100644 index 000000000..404743c45 --- /dev/null +++ b/FS/FS/part_event/Condition/svc_acct_overlimit.pm @@ -0,0 +1,57 @@ +package FS::part_event::Condition::svc_acct_overlimit; + +use strict; +use FS::svc_acct; + +use base qw( FS::part_event::Condition ); + +sub description { 'Service is over its usage limit' }; + +sub eventtable_hashref { + { 'svc_acct' => 1 } +} + +tie my %usage_types, 'Tie::IxHash', ( + 'seconds' => 'Time', + 'upbytes' => 'Upload', + 'downbytes' => 'Download', + 'totalbytes'=> 'Total transfer', +); + +sub option_fields { + ( + 'usage_types' => { + type => 'checkbox-multiple', + options => [ keys %usage_types ], + option_labels => \%usage_types, + }, + ); +} + + +sub condition { + my($self, $svc_acct) = @_; + + my $types = $self->option('usage_types') || {}; + foreach my $column (keys %$types) { + # don't trigger if this type of usage isn't tracked on the service + next if $svc_acct->$column eq ''; + + return 1 if ( $svc_acct->$column <= 0 ); + } + return 0; +} + +sub condition_sql { + my($self) = @_; + + # not an exact condition_sql--ignores the usage_types option + '(' . join(' OR ', + map { + "( svc_acct.$_ IS NOT NULL AND svc_acct.$_ <= 0 )" + } keys %usage_types + ) . ')' +} + +1; + diff --git a/FS/FS/part_event/Condition/svc_acct_threshold.pm b/FS/FS/part_event/Condition/svc_acct_threshold.pm new file mode 100644 index 000000000..85d57119d --- /dev/null +++ b/FS/FS/part_event/Condition/svc_acct_threshold.pm @@ -0,0 +1,63 @@ +package FS::part_event::Condition::svc_acct_threshold; + +use strict; +use FS::svc_acct; + +use base qw( FS::part_event::Condition ); + +sub description { 'Service is over its usage warning threshold' }; + +sub eventtable_hashref { + { 'svc_acct' => 1 } +} + +tie my %usage_types, 'Tie::IxHash', ( + 'seconds' => 'Time', + 'upbytes' => 'Upload', + 'downbytes' => 'Download', + 'totalbytes'=> 'Total transfer', +); + +sub option_fields { + ( + 'usage_types' => { + type => 'checkbox-multiple', + options => [ keys %usage_types ], + option_labels => \%usage_types, + }, + ); +} + +sub condition { + my($self, $svc_acct) = @_; + + my $types = $self->option('usage_types') || {}; + foreach my $column (keys %$types) { + # don't trigger if this type of usage isn't tracked on the service + next if $svc_acct->$column eq ''; + my $threshold; + my $method = $column.'_threshold'; + $threshold = $svc_acct->$method; + # don't trigger if seconds = 0 and seconds_threshold is null + next if $threshold eq ''; + + return 1 if ( $svc_acct->$column <= $threshold ); + } + return 0; +} + +sub condition_sql { + my($self) = @_; + + # not an exact condition_sql--ignores the usage_types option + '(' . join(' OR ', + map { + my $threshold = $_.'_threshold'; + "( svc_acct.$_ IS NOT NULL AND svc_acct.$threshold IS NOT NULL AND ". + "svc_acct.$_ <= svc_acct.$threshold )" + } keys %usage_types + ) . ')' +} + +1; + diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index 5c6e16b82..e83d96ec1 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -159,6 +159,16 @@ sub label_long { $self->label(@_); } +sub cust_main { + my $self = shift; + (($self->cust_svc || return)->cust_pkg || return)->cust_main || return +} + +sub cust_linked { + my $self = shift; + defined($self->cust_main); +} + =item check Checks the validity of fields in this record. diff --git a/httemplate/edit/part_event.html b/httemplate/edit/part_event.html index 6a532223e..e005cbba0 100644 --- a/httemplate/edit/part_event.html +++ b/httemplate/edit/part_event.html @@ -22,6 +22,11 @@ type => 'checkbox', value => 'Y', }, + { field => '_initialize', + type => 'checkbox', + onchange => '_initialize_changed', + value => 'Y', + }, { type => 'title', value => 'Event Conditions', }, @@ -54,7 +59,6 @@ layer_values_callback => $action_layer_values, html_between => n_a('action'), }, - ], 'labels' => { 'eventpart' => 'Event', @@ -67,6 +71,7 @@ 'conditionname' => 'Add new condition', #'weight', 'action' => 'Action', + '_initialize' => 'Initialize event', }, 'viewall_dir' => 'browse', 'new_callback' => sub { #start empty for new events only @@ -469,6 +474,16 @@ } + function _initialize_changed(what) { + document.getElementById('disabled').disabled = what.checked; + if ( what.checked ) { +%# because it's not an immediately obvious concept + alert('Initializing the event will treat it as "already run" on the '+ + 'current date for all existing customers. This affects '+ + 'conditions that prevent running an event more than once.'); + } + } + <%once> diff --git a/httemplate/edit/process/part_event.html b/httemplate/edit/process/part_event.html index 6a8ddd1ea..d4d4526e0 100644 --- a/httemplate/edit/process/part_event.html +++ b/httemplate/edit/process/part_event.html @@ -81,8 +81,21 @@ length($actionfields{'reasonnum'}) == 0 ) { return 'Reason required'; } + if ( $cgi->param('_initialize') ) { + $cgi->param('disabled', 'Y'); + } return ''; }, + 'noerror_callback' => sub { + my ($cgi, $new) = @_; + if ( $cgi->param('_initialize') ) { + my $job = new FS::queue { + 'job' => 'FS::part_event::process_initialize' + }; + my $error = $job->insert('eventpart' => $new->eventpart); + warn "error queueing job: $error\n" if $error; # can't do anything else + } + }, 'agent_virt' => 1, 'agent_null_right' => 'Edit global billing events', -- 2.11.0