diff options
author | Jonathan Prykop <jonathan@freeside.biz> | 2016-07-26 16:42:54 -0500 |
---|---|---|
committer | Jonathan Prykop <jonathan@freeside.biz> | 2016-07-26 16:42:54 -0500 |
commit | 14a5274c8b8cd2700d7141c8c15903bac881d46c (patch) | |
tree | a84ae1250010d5947153172327528768dde6f705 /FS/FS | |
parent | a1930173f49200333e347b87c01c3edabc1ebb9c (diff) |
RT#38217: Send email when logging conditions are met [removed unwanted log levels, preserved level num mapping]
Diffstat (limited to 'FS/FS')
-rw-r--r-- | FS/FS/Log.pm | 33 | ||||
-rw-r--r-- | FS/FS/Upgrade.pm | 3 | ||||
-rw-r--r-- | FS/FS/log.pm | 47 |
3 files changed, 79 insertions, 4 deletions
diff --git a/FS/FS/Log.pm b/FS/FS/Log.pm index 2fd0020..aed1f39 100644 --- a/FS/FS/Log.pm +++ b/FS/FS/Log.pm @@ -5,13 +5,20 @@ use FS::Record qw(qsearch qsearchs); use FS::Conf; use FS::Log::Output; use FS::log; -use vars qw(@STACK @LEVELS); +use vars qw(@STACK %LEVELS); # override the stringification of @_ with something more sensible. BEGIN { - @LEVELS = qw(debug info notice warning error critical alert emergency); + # subset of Log::Dispatch levels + %LEVELS = ( + 0 => 'debug', + 1 => 'info', + 3 => 'warning', + 4 => 'error', + 5 => 'critical' + ); - foreach my $l (@LEVELS) { + foreach my $l (values %LEVELS) { my $sub = sub { my $self = shift; $self->log( level => $l, message => @_ ); @@ -100,4 +107,24 @@ sub DESTROY { splice(@STACK, $self->{'index'}, 1); # delete the stack entry } +=item levelnums + +Subroutine. Returns ordered list of level nums. + +=cut + +sub levelnums { + sort keys %LEVELS; +} + +=item levelmap + +Subroutine. Returns ordered map of level num => level name. + +=cut + +sub levelmap { + map { $_ => $LEVELS{$_} } levelnums; +} + 1; diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm index 65b83bd..3faf47e 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -352,6 +352,9 @@ sub upgrade_data { tie my %hash, 'Tie::IxHash', + #remap log levels + 'log' => [], + #cust_main (remove paycvv from history, locations, cust_payby, etc) 'cust_main' => [], diff --git a/FS/FS/log.pm b/FS/FS/log.pm index 1d4df73..d432ee3 100644 --- a/FS/FS/log.pm +++ b/FS/FS/log.pm @@ -6,6 +6,8 @@ use FS::Record qw( qsearch qsearchs dbdef ); use FS::UID qw( dbh driver_name ); use FS::log_context; use FS::log_email; +use FS::upgrade_journal; +use Tie::IxHash; =head1 NAME @@ -115,7 +117,7 @@ sub insert { 'msgtype' => 'admin', 'to' => $log_email->to_addr, 'substitutions' => { - 'loglevel' => $FS::Log::LEVELS[$self->level], # which has hopefully been loaded... + '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, }, @@ -383,6 +385,49 @@ sub search { }; } +sub _upgrade_data { + my ($class, %opts) = @_; + + return if FS::upgrade_journal->is_done('log__remap_levels'); + + tie my %levelmap, 'Tie::IxHash', + 2 => 1, #notice -> info + 6 => 5, #alert -> critical + 7 => 5, #emergency -> critical + ; + + # this method should never autocommit + # should have been set in upgrade, but just in case... + local $FS::UID::AutoCommit = 0; + + # in practice, only debug/info/warning/error appear to have been used, + # so this probably won't do anything, but just in case + foreach my $old (keys %levelmap) { + # FS::log has no replace method + my $sql = 'UPDATE log SET level=' . dbh->quote($levelmap{$old}) . ' WHERE level=' . dbh->quote($old); + warn $sql unless $opts{'quiet'}; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute() or die $sth->errstr; + $sth->finish(); + } + + foreach my $log_email ( + qsearch('log_email',{ 'min_level' => 2 }), + qsearch('log_email',{ 'min_level' => 6 }), + qsearch('log_email',{ 'min_level' => 7 }), + ) { + $log_email->min_level($levelmap{$log_email->min_level}); + my $error = $log_email->replace; + if ($error) { + dbh->rollback; + die $error; + } + } + + FS::upgrade_journal->set_done('log__remap_levels'); + +} + =back =head1 BUGS |