Commit | Line | Data |
4e446335 |
1 | package Object::Remote::Logging::Logger; |
2 | |
3 | use Moo; |
4 | use Scalar::Util qw(weaken); |
f21127fd |
5 | use Carp qw(croak); |
4e446335 |
6 | |
f21127fd |
7 | #TODO sigh invoking a logger with a log level name the same |
8 | #as an attribute could happen - restrict attributes to _ prefix |
9 | #and restrict log levels to not start with out that prefix? |
0fe333eb |
10 | has format => ( is => 'ro', required => 1, default => sub { '%l: %s' } ); |
4e446335 |
11 | has level_names => ( is => 'ro', required => 1 ); |
f21127fd |
12 | has min_level => ( is => 'ro', required => 1, default => sub { 'info' } ); |
455d031c |
13 | has max_level => ( is => 'lazy', required => 1 ); |
4e446335 |
14 | has _level_active => ( is => 'lazy' ); |
15 | |
f21127fd |
16 | #just a stub so it doesn't get to AUTOLOAD |
17 | sub BUILD { } |
18 | sub DESTROY { } |
19 | |
20 | sub AUTOLOAD { |
21 | my $self = shift; |
22 | (my $method) = (our $AUTOLOAD =~ /([^:]+)$/); |
23 | |
24 | no strict 'refs'; |
25 | |
26 | if ($method =~ m/^_/) { |
27 | croak "invalid method name $method for " . ref($self); |
28 | } |
29 | |
30 | if ($method =~ m/^is_(.+)/) { |
31 | my $level_name = $1; |
32 | my $is_method = "is_$level_name"; |
33 | *{$is_method} = sub { shift(@_)->_level_active->{$level_name} }; |
34 | return $self->$is_method; |
35 | } |
36 | |
37 | my $level_name = $method; |
38 | *{$level_name} = sub { |
39 | my $self = shift; |
40 | unless(exists($self->_level_active->{$level_name})) { |
41 | croak "$level_name is not a valid log level name"; |
42 | } |
43 | |
44 | $self->_log($level_name, @_); |
45 | }; |
46 | |
47 | return $self->$level_name(@_); |
4e446335 |
48 | } |
49 | |
455d031c |
50 | sub _build_max_level { |
51 | my ($self) = @_; |
52 | return $self->level_names->[-1]; |
53 | } |
54 | |
4e446335 |
55 | sub _build__level_active { |
c0b2df05 |
56 | my ($self) = @_; |
57 | my $should_log = 0; |
58 | my $min_level = $self->min_level; |
59 | my $max_level = $self->max_level; |
60 | my %active; |
4e446335 |
61 | |
c0b2df05 |
62 | foreach my $level (@{$self->level_names}) { |
63 | if($level eq $min_level) { |
64 | $should_log = 1; |
65 | } |
66 | |
67 | $active{$level} = $should_log; |
4e446335 |
68 | |
c0b2df05 |
69 | if (defined $max_level && $level eq $max_level) { |
70 | $should_log = 0; |
4e446335 |
71 | } |
c0b2df05 |
72 | } |
73 | |
74 | return \%active; |
4e446335 |
75 | } |
76 | |
4e446335 |
77 | sub _log { |
c0b2df05 |
78 | my ($self, $level, $content, $metadata_in) = @_; |
c0b2df05 |
79 | my %metadata = %$metadata_in; |
80 | my $rendered = $self->_render($level, \%metadata, @$content); |
81 | $self->_output($rendered); |
4e446335 |
82 | } |
83 | |
454ec6a2 |
84 | sub _create_format_lookup { |
85 | my ($self, $level, $metadata, $content) = @_; |
b43174a1 |
86 | my $method = $metadata->{method}; |
87 | |
88 | $method = '(none)' unless defined $method; |
89 | |
454ec6a2 |
90 | return { |
91 | '%' => '%', t => $self->_render_time($metadata->{timestamp}), |
92 | r => $self->_render_remote($metadata->{object_remote}), |
238812ba |
93 | s => $self->_render_log(@$content), l => $level, |
eb49c7df |
94 | c => $metadata->{controller}, p => $metadata->{package}, m => $method, |
466ee2c4 |
95 | f => $metadata->{filename}, i => $metadata->{line}, |
96 | h => $metadata->{hostname}, P => $metadata->{pid}, |
454ec6a2 |
97 | }; |
98 | } |
99 | |
100 | sub _get_format_var_value { |
101 | my ($self, $name, $data) = @_; |
102 | my $val = $data->{$name}; |
103 | return $val if defined $val; |
466ee2c4 |
104 | return '(undefined)'; |
454ec6a2 |
105 | } |
106 | |
107 | sub _render_time { |
108 | my ($self, $time) = @_; |
109 | return scalar(localtime($time)); |
110 | } |
111 | |
112 | sub _render_remote { |
113 | my ($self, $remote) = @_; |
114 | return 'local' if ! defined $remote || ! defined $remote->{connection_id}; |
115 | return 'remote #' . $remote->{connection_id}; |
116 | } |
117 | |
118 | sub _render_log { |
119 | my ($self, @content) = @_; |
120 | return join('', @content); |
121 | } |
4e446335 |
122 | sub _render { |
c0b2df05 |
123 | my ($self, $level, $metadata, @content) = @_; |
454ec6a2 |
124 | my $var_table = $self->_create_format_lookup($level, $metadata, [@content]); |
125 | my $template = $self->format; |
f4a85080 |
126 | |
466ee2c4 |
127 | $template =~ s/%([\w%])/$self->_get_format_var_value($1, $var_table)/ge; |
f4a85080 |
128 | |
454ec6a2 |
129 | chomp($template); |
130 | $template =~ s/\n/\n /g; |
131 | $template .= "\n"; |
132 | return $template; |
4e446335 |
133 | } |
134 | |
135 | sub _output { |
c0b2df05 |
136 | my ($self, $content) = @_; |
137 | print STDERR $content; |
4e446335 |
138 | } |
139 | |
4e446335 |
140 | 1; |
141 | |
455d031c |
142 | __END__ |
143 | |
144 | =head1 NAME |
145 | |
146 | Object::Remote::Logging::Logger - Format and output a log message |
147 | |
148 | =head1 SYNOPSIS |
149 | |
150 | use Object::Remote::Logging::Logger; |
151 | use Object::Remote::Logging qw( router arg_levels ); |
152 | |
153 | my $app_output = Object::Remote::Logging::Logger->new( |
154 | level_names => arg_levels, format => '%t %s', |
155 | min_level => 'verbose', max_level => 'info', |
156 | ); |
157 | |
158 | #Selector method can return 0 or more logger |
159 | #objects that will receive the messages |
160 | my $selector = sub { |
161 | my ($generating_package, $metadata) = @_; |
162 | return unless $metadata->{controller} eq 'App::Logging::Subclass'; |
163 | return $app_output; |
164 | }; |
165 | |
166 | #true value as second argument causes the selector |
167 | #to be stored with a weak reference |
168 | router->connect($selector, 1); |
169 | |
170 | #disconnect the selector from the router |
171 | undef($selector); |
172 | |
173 | #router will hold this logger forever |
174 | #and send it all log messages |
175 | router->connect(Object::Remote::Logging::WarnLogger->new( |
176 | level_names => arg_levels, format => '%s at %f line %i, log level: %l' |
177 | min_level => 'warn', max_level => 'error', |
178 | )); |
179 | |
180 | =head1 DESCRIPTION |
181 | |
182 | This class receives log messages from an instance of L<Object::Remote::Log::Router>, |
183 | formats them according to configuration, and then outputs them to STDERR. In between |
184 | the router and the logger is a selector method which inspects the log message metadata |
185 | and can return 0 or more loggers that should receive the log message. |
186 | |
187 | =head1 USAGE |
188 | |
189 | A logger object receives the log messages that are generated and converts them to |
190 | formatted log entries then displays them to the end user. Each logger has a set |
191 | of active log levels and will only output a log entry if the log message is at |
192 | an active log level. |
193 | |
194 | To gain access to the stream of log messages a connection is made to the log router. |
195 | A logger can directly connect to the router and receive an unfiltered stream of |
196 | log messages or a selector closure can be used instead. The selector will be executed |
197 | for each log message with the message metadata and returns a list of 0 or more loggers |
198 | that should receive the log message. When the selector is executed the first argument |
199 | is the class name of the package that generated the log message and the second argument |
200 | is a hash reference containing the message metadata. |
201 | |
202 | =head1 METADATA |
203 | |
204 | The message metadata is a hash reference with the following keys: |
205 | |
206 | =over 4 |
207 | |
208 | =item level |
209 | |
210 | Name of the log level of the message. |
211 | |
212 | =item controller |
213 | |
214 | Name of the sub-class of Object::Remote::Logging in use by |
215 | the generating package. |
216 | |
217 | =item package |
218 | |
219 | Name of the package that generated the log message. |
220 | |
221 | =item method |
222 | |
223 | Name of the method the message was generated inside of. |
224 | |
225 | =item timestamp |
226 | |
227 | Unix time of the message generation. |
228 | |
229 | =item pid |
230 | |
231 | Process id of the Perl interpreter the message was generated in. |
232 | |
233 | =item hostname |
234 | |
235 | Hostname of the system where the message was generated. |
236 | |
237 | =item filename |
238 | |
239 | Name of the file the message was generated in. |
240 | |
241 | =item line |
242 | |
243 | Line of the source file the message was generated at. |
244 | |
245 | =item object_remote |
246 | |
247 | This is a reference to another hash that contains the Object::Remote |
248 | specific information. The keys are |
249 | |
250 | =over 4 |
251 | |
252 | =item connection_id |
253 | |
254 | If the log message was generated on a remote Perl interpreter then the |
255 | Object::Remote::Connection id of that interpreter will be available here. |
256 | |
257 | =back |
258 | |
259 | =back |
260 | |
261 | =head1 ATTRIBUTES |
262 | |
263 | =over 4 |
264 | |
265 | =item level_names |
266 | |
267 | This is a required attribute. Must be an array ref with the list of log level names |
268 | in it. The list must be ordered with the lowest level as element 0 and the highest |
269 | level as the last element. There is no default value. |
270 | |
271 | =item min_level |
272 | |
273 | The lowest log level that will be output by the logger. There is no default value. |
274 | |
275 | =item max_level |
276 | |
277 | The highest log level that will be output by the logger. The default value is the |
278 | highest level present in level_names. |
279 | |
280 | =item format |
281 | |
282 | The printf style format string to use when rendering the log message. The following |
283 | sequences are significant: |
284 | |
285 | =over 4 |
286 | |
287 | =item %l |
288 | |
289 | Level name that the log message was generated at. |
290 | |
291 | =item %s |
292 | |
293 | Log message rendered into a string with a leading space before any additional lines in a |
294 | multiple line message. |
295 | |
296 | =item %t |
297 | |
298 | Time the log message was generated rendered into a string. The time value is taken from |
299 | the Perl interpreter that generated the log message; it is not the time that the logger |
300 | received the log message on the local interpreter if the log message was forwarded. |
301 | |
302 | =item %r |
303 | |
304 | Log::Remote connection information rendered into a string. |
305 | |
306 | =item %c |
307 | |
308 | Name of the sub-class of Object::Remote::Logging that was used by the class |
309 | that generated the log message. Can also be Object::Remote::Logging itself. |
310 | |
311 | =item %p |
312 | |
313 | Package name of the class that generated the log message. |
314 | |
315 | =item %m |
316 | |
317 | Method name that generated the log message. |
318 | |
319 | =item %f |
320 | |
321 | Filename that the log message was generated in. |
322 | |
323 | =item %i |
324 | |
325 | Line number the log message was generated at. |
326 | |
327 | =item %h |
328 | |
329 | Hostname the log message was generated on. |
330 | |
331 | =item %P |
332 | |
333 | Process id of the Perl interpreter that generated the log message. |
334 | |
335 | =item %% |
336 | |
337 | A literal %. |
338 | |
339 | =back |
340 | |
341 | =back |
342 | |