X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Flog.pm;h=875e1ac016b8d789812bd91f6bb3f0299bf3e184;hp=a4ad214d020fe23099ff0c5436c9567e8135ed7a;hb=20f03d52cc6c930f610c0b4466eeeeda54fdbb40;hpb=913bd0405d6eb0db41b9944dfd42eb1f97d18ca9

diff --git a/FS/FS/log.pm b/FS/FS/log.pm
index a4ad214d0..875e1ac01 100644
--- a/FS/FS/log.pm
+++ b/FS/FS/log.pm
@@ -4,7 +4,11 @@ use strict;
 use base qw( FS::Record );
 use FS::Record qw( qsearch qsearchs dbdef );
 use FS::UID qw( dbh driver_name );
+use FS::Log;
 use FS::log_context;
+use FS::log_email;
+use FS::upgrade_journal;
+use Tie::IxHash;
 
 =head1 NAME
 
@@ -44,8 +48,7 @@ this will be set to that agentnum.
 
 =item tablenum - foreign key to that table.
 
-=item level - log level: 'debug', 'info', 'notice', 'warning', 'error', 
-'critical', 'alert', 'emergency'.
+=item level - log level: 'debug', 'info', 'warning', 'error', 'critical',
 
 =item message - contents of the log entry
 
@@ -71,6 +74,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,18 +83,53 @@ sub insert {
   my $self = shift;
   my $error = $self->SUPER::insert;
   return $error if $error;
-  foreach ( @_ ) {
+
+  my $contexts = {};       # for quick checks when sending emails
+  my $context_height = @_; # also for email check
+  foreach ( @_ ) { # ordered from least to most specific
     my $context = FS::log_context->new({
         'lognum'  => $self->lognum,
         'context' => $_
     });
     $error = $context->insert;
     return $error if $error;
+    $contexts->{$_} = $context_height--;
+  }
+
+  foreach my $log_email (
+    qsearch('log_email',
+      {
+        'disabled' => '',
+        'min_level' => {
+          'op' => '<=',
+          'value' => $self->level,
+        },
+      }
+    )
+  ) {
+    # shouldn't be a lot of log_email records, so not packing these checks into the qsearch
+    next if $log_email->context && !$contexts->{$log_email->context};
+    next if $log_email->context_height && ($contexts->{$log_email->context} > $log_email->context_height);
+    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(
+      'msgtype' => 'admin',
+      'to'      => $log_email->to_addr,
+      'substitutions' => {
+        'loglevel'   => $FS::Log::LEVELS{$self->level} || 'unknown',
+        'logcontext' => join(', ', keys( %$contexts )) || 'unknown',
+        '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." };
 
@@ -114,7 +154,7 @@ sub check {
     || $self->ut_textn('tablename')
     || $self->ut_numbern('tablenum')
     || $self->ut_number('level')
-    || $self->ut_text('message')
+    || $self->ut_anything('message')
   ;
   return $error if $error;
 
@@ -312,9 +352,16 @@ sub search {
 
   if ( $params->{'context'} ) {
     my $quoted = dbh->quote($params->{'context'});
-    push @where, 
-      "EXISTS(SELECT 1 FROM log_context WHERE log.lognum = log_context.lognum ".
-      "AND log_context.context = $quoted)";
+    if ( $params->{'context_height'} =~ /^\d+$/ ) {
+      my $subq = 'SELECT context FROM log_context WHERE log.lognum = log_context.lognum'.
+                 ' ORDER BY logcontextnum DESC LIMIT '.$params->{'context_height'};
+      push @where,
+        "EXISTS(SELECT 1 FROM ($subq) AS log_context_x WHERE log_context_x.context = $quoted)";
+    } else {
+      push @where, 
+        "EXISTS(SELECT 1 FROM log_context WHERE log.lognum = log_context.lognum ".
+        "AND log_context.context = $quoted)";
+    }
   }
 
   # agent virtualization
@@ -340,6 +387,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