FS/FS/Log.pm

   1 package FS::Log;
   2
   3 use base 'Log::Dispatch';
   4 use FS::Record qw(qsearch qsearchs);
   5 use FS::Conf;
   6 use FS::Log::Output;
   7 use FS::log;
   8 use vars qw(@STACK %LEVELS);
   9
  10 # override the stringification of @_ with something more sensible.
  11 BEGIN {
  12   # subset of Log::Dispatch levels
  13   %LEVELS = (
  14     0 => 'debug',
  15     1 => 'info',
  16     3 => 'warning',
  17     4 => 'error',
  18     5 => 'critical'
  19   );
  20
  21   foreach my $l (values %LEVELS) {
  22     my $sub = sub {
  23       my $self = shift;
  24       $self->log( level => $l, message => @_ );
  25     };
  26     no strict 'refs';
  27     *{$l} = $sub;
  28   }
  29 }
  30
  31 =head1 NAME
  32
  33 FS::Log - Freeside event log
  34
  35 =head1 SYNOPSIS
  36
  37 use FS::Log;
  38
  39 sub do_something {
  40   my $log = FS::Log->new('do_something'); # set log context to 'do_something'
  41
  42   ...
  43   if ( $error ) {
  44     $log->error('something is wrong: '.$error);
  45     return $error;
  46   }
  47   # at this scope exit, do_something is removed from context
  48 }
  49
  50 =head1 DESCRIPTION
  51
  52 FS::Log provides an interface for logging errors and profiling information
  53 to the database.  FS::Log inherits from L<Log::Dispatch>.
  54
  55 =head1 CLASS METHODS
  56
  57 =over 4
  58
  59 =item new CONTEXT
  60
  61 Constructs and returns a log handle.  CONTEXT must be a known context tag
  62 indicating what activity is going on, such as the name of the function or
  63 script that is executing.
  64
  65 Log context is a stack, and each element is removed from the stack when it
  66 goes out of scope.  So don't keep log handles in persistent places (i.e.
  67 package variables or class-scoped lexicals).
  68
  69 =cut
  70
  71 sub new {
  72   my $class = shift;
  73   my $context = shift;
  74
  75   my $min_level = FS::Conf->new->config('event_log_level') || 'info';
  76
  77   my $self = $class->SUPER::new(
  78     outputs => [ [ '+FS::Log::Output', min_level => $min_level ] ],
  79   );
  80   $self->{'index'} = scalar(@STACK);
  81   push @STACK, $context;
  82   return $self;
  83 }
  84
  85 =item context
  86
  87 Returns the current context stack.
  88
  89 =cut
  90
  91 sub context { @STACK };
  92
  93 =item log LEVEL, MESSAGE[, OPTIONS ]
  94
  95 Like L<Log::Dispatch::log>, but OPTIONS may include:
  96
  97 - agentnum
  98 - object (an <FS::Record> object to reference in this log message)
  99 - tablename and tablenum (an alternate way of specifying 'object')
 100
 101 =cut
 102
 103 # inherited
 104
 105 sub DESTROY {
 106   my $self = shift;
 107   splice(@STACK, $self->{'index'}, 1); # delete the stack entry
 108 }
 109
 110 =item levelnums
 111
 112 Subroutine.  Returns ordered list of level nums.
 113
 114 =cut
 115
 116 sub levelnums {
 117   sort keys %LEVELS;
 118 }
 119
 120 =item levelmap
 121
 122 Subroutine.  Returns ordered map of level num => level name.
 123
 124 =cut
 125
 126 sub levelmap {
 127   map { $_ => $LEVELS{$_} } levelnums;
 128 }
 129
 130 1;