diff options
Diffstat (limited to 'FS')
| -rw-r--r-- | FS/FS/Schema.pm | 19 | ||||
| -rw-r--r-- | FS/FS/log.pm | 35 | ||||
| -rw-r--r-- | FS/FS/log_email.pm | 108 | ||||
| -rw-r--r-- | FS/FS/msg_template.pm | 6 |
4 files changed, 164 insertions, 4 deletions
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 447a6bcad..ecd071e49 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -4658,6 +4658,25 @@ sub tables_hashref { 'index' => [], }, + 'log_email' => { + 'columns' => [ + 'logemailnum', 'serial', '', '', '', '', + 'context', 'varchar', 'NULL', $char_d, '', '', + 'min_level', 'int', 'NULL', '', '', '', + 'msgnum', 'int', '', '', '', '', + 'to_addr', 'varchar', 'NULL', 255, '', '', + ], + 'primary_key' => 'logemailnum', + 'unique' => [], + 'index' => [ ['context'], ['min_level'] ], + 'foreign_keys' => [ + { columns => [ 'msgnum' ], + table => 'msg_template', + references => [ 'msgnum' ], + }, + ], + }, + 'svc_alarm' => { 'columns' => [ # name type null length default local diff --git a/FS/FS/log.pm b/FS/FS/log.pm index 547beb7d0..18ba7c936 100644 --- a/FS/FS/log.pm +++ b/FS/FS/log.pm @@ -5,6 +5,7 @@ use base qw( FS::Record ); use FS::Record qw( qsearch qsearchs dbdef ); use FS::UID qw( dbh driver_name ); use FS::log_context; +use FS::log_email; =head1 NAME @@ -71,6 +72,8 @@ otherwise returns false. CONTEXT may be a list of context tags to attach to this record. +Will send emails according to the conditions in L<FS::log_email>. + =cut sub insert { @@ -78,6 +81,7 @@ sub insert { my $self = shift; my $error = $self->SUPER::insert; return $error if $error; + my $contexts = {}; #for quick checks when sending emails foreach ( @_ ) { my $context = FS::log_context->new({ 'lognum' => $self->lognum, @@ -85,11 +89,40 @@ sub insert { }); $error = $context->insert; return $error if $error; + $contexts->{$_} = 1; + } + foreach my $log_email ( + qsearch('log_email', + { + 'disabled' => '', + 'min_level' => { + 'op' => '<=', + 'value' => $self->level, + }, + } + ) + ) { + # shouldn't be a lot of these, so not packing this into the qsearch + next if $log_email->context && !$contexts->{$log_email->context}; + my $msg_template = qsearchs('msg_template',{ 'msgnum' => $log_email->msgnum }); + unless ($msg_template) { + warn "Could not send email when logging, could not load message template for logemailnum " . $log_email->logemailnum; + next; + } + my $emailerror = $msg_template->send( + 'to' => $log_email->to_addr, + 'substitutions' => { + 'loglevel' => $FS::Log::LEVELS[$self->level], # which has hopefully been loaded... + 'logcontext' => $log_email->context, # use the one that triggered the email + 'logmessage' => $self->message, + }, + ); + warn "Could not send email when logging: $emailerror" if $emailerror; } ''; } -# the insert method can be inherited from FS::Record +# these methods can be inherited from FS::Record sub delete { die "Log entries can't be modified." }; diff --git a/FS/FS/log_email.pm b/FS/FS/log_email.pm new file mode 100644 index 000000000..9c53c230a --- /dev/null +++ b/FS/FS/log_email.pm @@ -0,0 +1,108 @@ +package FS::log_email; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs dbdef ); +use FS::UID qw( dbh driver_name ); + +=head1 NAME + +FS::log_email - Object methods for log email records + +=head1 SYNOPSIS + + use FS::log_email; + + $record = new FS::log_email \%hash; + $record = new FS::log_email { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::log object represents the conditions for sending an email +when a log entry is created. FS::log inherits from FS::Record. +The following fields are currently supported: + +=over 4 + +=item logemailnum - primary key + +=item context - the context that will trigger the email (all contexts if unspecified) + +=item min_level - the minimum log level that will trigger the email (all levels if unspecified) + +=item msgnum - the msg_template that will be used to send the email + +=item to_addr - who the email will be sent to (in addition to any bcc on the template) + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new log_email entry. + +=cut + +sub table { 'log_email'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. + +=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. + +=item check + +Checks all fields to make sure this is a valid record. 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('logemailnum') + || $self->ut_textn('context') # not validating against list of contexts in log_context, + # because not even log_context check currently does so + || $self->ut_number('min_level') + || $self->ut_foreign_key('msgnum', 'msg_template', 'msgnum') + || $self->ut_textn('to_addr') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/msg_template.pm b/FS/FS/msg_template.pm index 50a9b3f27..2388aba69 100644 --- a/FS/FS/msg_template.pm +++ b/FS/FS/msg_template.pm @@ -239,7 +239,7 @@ Options are passed as a list of name/value pairs: =item cust_main -Customer object (required). +Customer object =item object @@ -277,8 +277,8 @@ A hash reference of additional substitutions sub prepare { my( $self, %opt ) = @_; - my $cust_main = $opt{'cust_main'} or die 'cust_main required'; - my $object = $opt{'object'} or die 'object required'; + my $cust_main = $opt{'cust_main'}; # or die 'cust_main required'; + my $object = $opt{'object'}; # or die 'object required'; # localization my $locale = $cust_main->locale || ''; |