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   @LEVELS = qw(debug info notice warning error critical alert emergency);
  13
  14   foreach my $l (@LEVELS) {
  15     my $sub = sub {
  16       my $self = shift;
  17       $self->log( level => $l, message => @_ );
  18     };
  19     no strict 'refs';
  20     *{$l} = $sub;
  21   }
  22 }
  23
  24 =head1 NAME
  25
  26 FS::Log - Freeside event log
  27
  28 =head1 SYNOPSIS
  29
  30 use FS::Log;
  31
  32 sub do_something {
  33   my $log = FS::Log->new('do_something'); # set log context to 'do_something'
  34
  35   ...
  36   if ( $error ) {
  37     $log->error('something is wrong: '.$error);
  38     return $error;
  39   }
  40   # at this scope exit, do_something is removed from context
  41 }
  42
  43 =head1 DESCRIPTION
  44
  45 FS::Log provides an interface for logging errors and profiling information
  46 to the database.  FS::Log inherits from L<Log::Dispatch>.
  47
  48 =head1 CLASS METHODS
  49
  50 =over 4
  51
  52 =item new CONTEXT
  53
  54 Constructs and returns a log handle.  CONTEXT must be a known context tag
  55 indicating what activity is going on, such as the name of the function or
  56 script that is executing.
  57
  58 Log context is a stack, and each element is removed from the stack when it
  59 goes out of scope.  So don't keep log handles in persistent places (i.e.
  60 package variables or class-scoped lexicals).
  61
  62 =cut
  63
  64 sub new {
  65   my $class = shift;
  66   my $context = shift;
  67
  68   my $min_level = FS::Conf->new->config('event_log_level') || 'info';
  69
  70   my $self = $class->SUPER::new(
  71     outputs => [ [ '+FS::Log::Output', min_level => $min_level ] ],
  72   );
  73   $self->{'index'} = scalar(@STACK);
  74   push @STACK, $context;
  75   return $self;
  76 }
  77
  78 =item context
  79
  80 Returns the current context stack.
  81
  82 =cut
  83
  84 sub context { @STACK };
  85
  86 =item log LEVEL, MESSAGE[, OPTIONS ]
  87
  88 Like L<Log::Dispatch::log>, but OPTIONS may include:
  89
  90 - agentnum
  91 - object (an <FS::Record> object to reference in this log message)
  92 - tablename and tablenum (an alternate way of specifying 'object')
  93
  94 =cut
  95
  96 # inherited
  97
  98 sub DESTROY {
  99   my $self = shift;
 100   splice(@STACK, $self->{'index'}, 1); # delete the stack entry
 101 }
 102
 103 1;