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