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 =back
 131
 132 =head1 BUGS
 133
 134 Not yet used universally; being phased in over time.
 135
 136 Not well documented.  Should document the error levels we're using (debug,
 137 info, warning, error, critical) and the methods to log them.
 138
 139 =head1 SEE ALSO
 140
 141 L<Log::Dispatch>
 142
 143 =cut
 144
 145 1;