line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::CLI::Interact::Logger; |
2
|
|
|
|
|
|
|
{ $Net::CLI::Interact::Logger::VERSION = '2.400000' } |
3
|
|
|
|
|
|
|
|
4
|
1
|
|
|
1
|
|
17
|
use Moo; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
7
|
|
5
|
1
|
|
|
1
|
|
388
|
use Sub::Quote; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
69
|
|
6
|
1
|
|
|
1
|
|
6
|
use MooX::Types::MooseLike::Base qw(HashRef Bool ArrayRef Any); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
73
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
579
|
use Class::Mix qw(genpkg); |
|
1
|
|
|
|
|
6838
|
|
|
1
|
|
|
|
|
65
|
|
9
|
1
|
|
|
1
|
|
17
|
use Time::HiRes qw(gettimeofday tv_interval); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
15
|
|
10
|
1
|
|
|
1
|
|
751
|
use Log::Dispatch::Config; # loads Log::Dispatch |
|
1
|
|
|
|
|
263650
|
|
|
1
|
|
|
|
|
48
|
|
11
|
1
|
|
|
1
|
|
555
|
use Log::Dispatch::Configurator::Any; |
|
1
|
|
|
|
|
12229
|
|
|
1
|
|
|
|
|
215
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub BUILDARGS { |
14
|
2
|
|
|
2
|
0
|
3618
|
my ($class, @args) = @_; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# accept single hash ref or naked hash |
17
|
2
|
50
|
|
|
|
11
|
my $params = (ref {} eq ref $args[0] ? $args[0] : {@args}); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# back-compat for old attr name |
20
|
2
|
50
|
|
|
|
11
|
$params->{log_stamp} = $params->{log_stamps} if exists $params->{log_stamps}; |
21
|
|
|
|
|
|
|
|
22
|
2
|
|
|
|
|
35
|
return $params; |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
has log_config => ( |
26
|
|
|
|
|
|
|
is => 'rw', |
27
|
|
|
|
|
|
|
isa => HashRef, |
28
|
|
|
|
|
|
|
builder => 1, |
29
|
|
|
|
|
|
|
trigger => quote_sub(q{ $_[0]->_clear_logger }), |
30
|
|
|
|
|
|
|
); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub _build_log_config { |
33
|
|
|
|
|
|
|
return { |
34
|
2
|
|
|
2
|
|
175
|
dispatchers => ['screen'], |
35
|
|
|
|
|
|
|
screen => { |
36
|
|
|
|
|
|
|
class => 'Log::Dispatch::Screen', |
37
|
|
|
|
|
|
|
min_level => 'debug', |
38
|
|
|
|
|
|
|
}, |
39
|
|
|
|
|
|
|
}; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
has _logger => ( |
43
|
|
|
|
|
|
|
is => 'ro', |
44
|
|
|
|
|
|
|
isa => quote_sub(q{ $_[0]->isa('Log::Dispatch::Config') }), |
45
|
|
|
|
|
|
|
builder => 1, |
46
|
|
|
|
|
|
|
lazy => 1, |
47
|
|
|
|
|
|
|
clearer => 1, |
48
|
|
|
|
|
|
|
); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# this allows each instance of this module to have its own |
51
|
|
|
|
|
|
|
# wrapped logger with different configuration. |
52
|
|
|
|
|
|
|
sub _build__logger { |
53
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
54
|
|
|
|
|
|
|
|
55
|
0
|
|
|
|
|
0
|
my $anon_logger = genpkg(); |
56
|
|
|
|
|
|
|
{ |
57
|
1
|
|
|
1
|
|
9
|
no strict 'refs'; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
716
|
|
|
0
|
|
|
|
|
0
|
|
58
|
0
|
|
|
|
|
0
|
@{"$anon_logger\::ISA"} = 'Log::Dispatch::Config'; |
|
0
|
|
|
|
|
0
|
|
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
0
|
|
|
|
|
0
|
my $config = Log::Dispatch::Configurator::Any->new($self->log_config); |
62
|
0
|
|
|
|
|
0
|
$anon_logger->configure($config); |
63
|
|
|
|
|
|
|
|
64
|
0
|
|
|
|
|
0
|
return $anon_logger->instance; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
has 'log_stamp' => ( |
68
|
|
|
|
|
|
|
is => 'rw', |
69
|
|
|
|
|
|
|
isa => Bool, |
70
|
|
|
|
|
|
|
default => quote_sub('1'), |
71
|
|
|
|
|
|
|
); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
has 'log_category' => ( |
74
|
|
|
|
|
|
|
is => 'rw', |
75
|
|
|
|
|
|
|
isa => Bool, |
76
|
|
|
|
|
|
|
default => quote_sub('1'), |
77
|
|
|
|
|
|
|
); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
has 'log_start' => ( |
80
|
|
|
|
|
|
|
is => 'ro', |
81
|
|
|
|
|
|
|
isa => ArrayRef, |
82
|
|
|
|
|
|
|
default => sub{ [gettimeofday] }, |
83
|
|
|
|
|
|
|
); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
has 'log_flags' => ( |
86
|
|
|
|
|
|
|
is => 'rw', |
87
|
|
|
|
|
|
|
isa => Any, # FIXME 'ArrayRef|HashRef[Str]', |
88
|
|
|
|
|
|
|
default => sub { {} }, |
89
|
|
|
|
|
|
|
); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
my %code_for = ( |
92
|
|
|
|
|
|
|
debug => 0, |
93
|
|
|
|
|
|
|
info => 1, |
94
|
|
|
|
|
|
|
notice => 2, |
95
|
|
|
|
|
|
|
warning => 3, |
96
|
|
|
|
|
|
|
error => 4, |
97
|
|
|
|
|
|
|
critical => 5, |
98
|
|
|
|
|
|
|
alert => 6, |
99
|
|
|
|
|
|
|
emergency => 7, |
100
|
|
|
|
|
|
|
); |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub would_log { |
103
|
2
|
|
|
2
|
1
|
6
|
my ($self, $category, $level) = @_; |
104
|
2
|
50
|
33
|
|
|
12
|
return 0 if !defined $category or !defined $level; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
my $flags = (ref $self->log_flags eq ref [] |
107
|
2
|
50
|
|
|
|
37
|
? { map {$_ => 'error'} @{$self->log_flags} } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
108
|
|
|
|
|
|
|
: $self->log_flags |
109
|
|
|
|
|
|
|
); |
110
|
|
|
|
|
|
|
|
111
|
2
|
50
|
|
|
|
63
|
return 0 if !exists $code_for{$level}; |
112
|
2
|
50
|
|
|
|
15
|
return 0 if !exists $flags->{$category}; |
113
|
0
|
|
|
|
|
0
|
return ($code_for{$level} >= $code_for{ $flags->{$category} }); |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub log { |
117
|
2
|
|
|
2
|
1
|
40
|
my ($self, $category, $level, @msgs) = @_; |
118
|
2
|
50
|
|
|
|
8
|
return unless $self->would_log($category, $level); |
119
|
0
|
|
|
|
|
|
@msgs = grep {defined} @msgs; |
|
0
|
|
|
|
|
|
|
120
|
0
|
0
|
|
|
|
|
return unless scalar @msgs; |
121
|
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
|
my $prefix = ''; |
123
|
0
|
0
|
|
|
|
|
$prefix .= sprintf "[%11s] ", sprintf "%.6f", (tv_interval $self->log_start, [gettimeofday]) |
124
|
|
|
|
|
|
|
if $self->log_stamp; |
125
|
0
|
0
|
|
|
|
|
$prefix .= (substr $category, 0, 2) |
126
|
|
|
|
|
|
|
if $self->log_category; |
127
|
|
|
|
|
|
|
|
128
|
0
|
|
|
|
|
|
my $suffix = ''; |
129
|
0
|
0
|
|
|
|
|
$suffix = "\n" if $msgs[-1] !~ m/\n$/; |
130
|
|
|
|
|
|
|
|
131
|
0
|
|
|
|
|
|
$self->_logger->$level($prefix . (' ' x (2 - $code_for{$level})), (join ' ', @msgs) . $suffix); |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
1; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=pod |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=head1 NAME |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
Net::CLI::Interact::Logger - Per-instance multi-target logging, with categories |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=head1 SYNOPSIS |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
$logger->log($category, $level, @message); |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=head1 DESCRIPTION |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
This module implements a generic logging service, based on L<Log::Dispatch> |
149
|
|
|
|
|
|
|
but with additional options and configuration. Log messages coming from your |
150
|
|
|
|
|
|
|
application are categorized, and each category can be enabled/disabled |
151
|
|
|
|
|
|
|
separately and have its own log level (i.e. C<emergency> .. C<debug>). High |
152
|
|
|
|
|
|
|
resolution timestamps can be added to log messages. |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=head1 DEFAULT CONFIGURATION |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
Being based on L<Log::Dispatch::Config>, this logger can have multiple |
157
|
|
|
|
|
|
|
targets, each configured for independent level thresholds. The overall default |
158
|
|
|
|
|
|
|
configuration is to print log messages to the screen (console), with a minimum |
159
|
|
|
|
|
|
|
level of C<debug>. Each category (see below) has its own log level as well. |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
Note that categories, as discussed below, are arbitrary so if a category is |
162
|
|
|
|
|
|
|
not explicitly enabled or disabled, it is assumed to be B<disabled>. If you |
163
|
|
|
|
|
|
|
wish to invent a new category for your application, simply think of the name |
164
|
|
|
|
|
|
|
and begin to use it, with a C<$level> and C<@message> as above in the |
165
|
|
|
|
|
|
|
SYNOPSIS. |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=head1 INTERFACE |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=head2 log( $category, $level, @message ) |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
The combination of category and level determine whether the the log messages |
172
|
|
|
|
|
|
|
are emitted to any of the log destinations. Destinations are set using the |
173
|
|
|
|
|
|
|
C<log_config> method, and categories are configured using the C<log_flags> |
174
|
|
|
|
|
|
|
method. |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
The C<@message> list will be joined by a space character, and a newline |
177
|
|
|
|
|
|
|
appended if the last message doesn't contain one itself. Messages are |
178
|
|
|
|
|
|
|
prepended with the first character of their C<$category>, and then indented |
179
|
|
|
|
|
|
|
proportionally to their C<$level>. |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=head2 log_config( \%config ) |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
A C<Log::Dispatch::Config> configuration (hash ref), meaning multiple log |
184
|
|
|
|
|
|
|
targets may be specified with different minimum level thresholds. There is a |
185
|
|
|
|
|
|
|
default configuration which emits messages to your screen (console) with no |
186
|
|
|
|
|
|
|
minimum threshold: |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
{ |
189
|
|
|
|
|
|
|
dispatchers => ['screen'], |
190
|
|
|
|
|
|
|
screen => { |
191
|
|
|
|
|
|
|
class => 'Log::Dispatch::Screen', |
192
|
|
|
|
|
|
|
min_level => 'debug', |
193
|
|
|
|
|
|
|
}, |
194
|
|
|
|
|
|
|
}; |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=head2 log_flags( \@categories | \%category_level_map ) |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
The user is expected to specify which log categories they are interested in, |
199
|
|
|
|
|
|
|
and at what levels. If a category is used in the application for logging but |
200
|
|
|
|
|
|
|
not specified, then it is deemed B<disabled>. Hence, even though the default |
201
|
|
|
|
|
|
|
destination log level is C<debug>, no messages are emitted until a category is |
202
|
|
|
|
|
|
|
enabled. |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
In the array reference form, the list should contain category names, and they |
205
|
|
|
|
|
|
|
will all be mapped to the C<error> level: |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
$logger->log_flags([qw/ |
208
|
|
|
|
|
|
|
network |
209
|
|
|
|
|
|
|
disk |
210
|
|
|
|
|
|
|
io |
211
|
|
|
|
|
|
|
cpu |
212
|
|
|
|
|
|
|
/]); |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
In the hash reference form, the keys should be category names and the values |
215
|
|
|
|
|
|
|
log levels from the list below (ordered such that each level "includes" the |
216
|
|
|
|
|
|
|
levels I<above>): |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
emergency |
219
|
|
|
|
|
|
|
alert |
220
|
|
|
|
|
|
|
critical |
221
|
|
|
|
|
|
|
error |
222
|
|
|
|
|
|
|
warning |
223
|
|
|
|
|
|
|
notice |
224
|
|
|
|
|
|
|
info |
225
|
|
|
|
|
|
|
debug |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
For example: |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
$logger->log_flags({ |
230
|
|
|
|
|
|
|
network => 'info', |
231
|
|
|
|
|
|
|
disk => 'debug', |
232
|
|
|
|
|
|
|
io => 'critical', |
233
|
|
|
|
|
|
|
cpu => 'debug', |
234
|
|
|
|
|
|
|
}); |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Messages at or above the specified level will be passed on to the |
237
|
|
|
|
|
|
|
C<Log::Dispatch> target, which may then specify an overriding threshold. |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=head2 C< Net::CLI::Interact->default_log_categories() >> |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
Not a part of this class, but the only way to retrieve a list of the current |
242
|
|
|
|
|
|
|
log categories used in the L<Net::CLI::Interact> distribution source. Does not |
243
|
|
|
|
|
|
|
take into account any log categories added by the user. |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=head2 log_stamp( $boolean ) |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
Enable (the default) or disable the display of high resolution interval |
248
|
|
|
|
|
|
|
timestamps with each log message. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=head2 log_category( $boolean ) |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
Enable (the default) or disable the display of the first letters of the |
253
|
|
|
|
|
|
|
category name with each log message. |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=head2 log_start( [$seconds, $microseconds] ) |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
Time of the start for generating a time interval when logging stamps. Defaults |
258
|
|
|
|
|
|
|
to the result of C<Time::HiRes::gettimeofday> at the point the module is |
259
|
|
|
|
|
|
|
loaded, in list context. |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=head2 would_log( $category, $level ) |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
Returns True if, according to the current C<log_flags>, the given C<$category> |
264
|
|
|
|
|
|
|
is enabled at or above the threshold of C<$level>, otherwise returns False. |
265
|
|
|
|
|
|
|
Note that the C<Log::Dispatch> targets maintain their own thresholds as well. |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=cut |
268
|
|
|
|
|
|
|
|