Commit | Line | Data |
---|---|---|
e3f7a951 RGS |
1 | package Log::Message; |
2 | ||
3 | use strict; | |
4 | ||
5 | use Params::Check qw[check]; | |
6 | use Log::Message::Item; | |
7 | use Log::Message::Config; | |
8 | use Locale::Maketext::Simple Style => 'gettext'; | |
9 | ||
10 | local $Params::Check::VERBOSE = 1; | |
11 | ||
12 | BEGIN { | |
13 | use vars qw[$VERSION @ISA $STACK $CONFIG]; | |
14 | ||
15 | $VERSION = 0.01; | |
16 | ||
17 | $STACK = []; | |
18 | } | |
19 | ||
20 | ||
21 | =pod | |
22 | ||
23 | =head1 NAME | |
24 | ||
25 | Log::Message - A generic message storing mechanism; | |
26 | ||
27 | =head1 SYNOPSIS | |
28 | ||
29 | use Log::Message private => 0, config => '/our/cf_file'; | |
30 | ||
31 | my $log = Log::Message->new( private => 1, | |
32 | level => 'log', | |
33 | config => '/my/cf_file', | |
34 | ); | |
35 | ||
36 | $log->store('this is my first message'); | |
37 | ||
38 | $log->store( message => 'message #2', | |
39 | tag => 'MY_TAG', | |
40 | level => 'carp', | |
41 | extra => ['this is an argument to the handler'], | |
42 | ); | |
43 | ||
44 | my @last_five_items = $log->retrieve(5); | |
45 | ||
46 | my @items = $log->retrieve( tag => qr/my_tag/i, | |
47 | message => qr/\d/, | |
48 | remove => 1, | |
49 | ); | |
50 | ||
51 | my @items = $log->final( level => qr/carp/, amount => 2 ); | |
52 | ||
53 | my $first_error = $log->first() | |
54 | ||
55 | # croak with the last error on the stack | |
56 | $log->final->croak; | |
57 | ||
58 | # empty the stack | |
59 | $log->flush(); | |
60 | ||
61 | ||
62 | =head1 DESCRIPTION | |
63 | ||
64 | Log::Message is a generic message storage mechanism. | |
65 | It allows you to store messages on a stack -- either shared or private | |
66 | -- and assign meta-data to it. | |
67 | Some meta-data will automatically be added for you, like a timestamp | |
68 | and a stack trace, but some can be filled in by the user, like a tag | |
69 | by which to identify it or group it, and a level at which to handle | |
70 | the message (for example, log it, or die with it) | |
71 | ||
72 | Log::Message also provides a powerful way of searching through items | |
73 | by regexes on messages, tags and level. | |
74 | ||
75 | =head1 Hierarchy | |
76 | ||
77 | There are 4 modules of interest when dealing with the Log::Message::* | |
78 | modules: | |
79 | ||
80 | =over 4 | |
81 | ||
82 | =item Log::Message | |
83 | ||
84 | Log::Message provides a few methods to manipulate the stack it keeps. | |
85 | It has the option of keeping either a private or a public stack. | |
86 | ||
87 | ||
88 | =item Log::Message::Item | |
89 | ||
90 | These are individual message items, which are objects that contain | |
91 | the user message as well as the meta-data described above. | |
92 | See the L<Log::Message::Item> manpage to see how to extract this | |
93 | meta-data and how to work with the Item objects. | |
94 | You should never need to create your own Item objects, but knowing | |
95 | about their methods and accessors is important if you want to write | |
96 | your own handlers. (See below) | |
97 | ||
98 | =item Log::Message::Handlers | |
99 | ||
100 | These are a collection of handlers that will be called for a level | |
101 | that is used on a L<Log::Message::Item> object. | |
102 | For example, if a message is logged with the 'carp' level, the 'carp' | |
103 | handler from L<Log::Message::Handlers> will be called. | |
104 | See the L<Log::Message::Handlers> manpage for more explanation about how | |
105 | handlers work, which one are available and how to create your own. | |
106 | ||
107 | =item Log::Message::Config | |
108 | ||
109 | Per Log::Message object, there is a configuration required that will | |
110 | fill in defaults if the user did not specify arguments to override | |
111 | them (like for example what tag will be set if none was provided), | |
112 | L<Log::Message::Config> handles the creation of these configurations. | |
113 | ||
114 | Configuration can be specified in 4 ways: | |
115 | ||
116 | =over 4 | |
117 | ||
118 | =item * | |
119 | ||
120 | As a configuration file when you C<use Log::Message> | |
121 | ||
122 | =item * | |
123 | ||
124 | As arguments when you C<use Log::Message> | |
125 | ||
126 | =item * | |
127 | ||
128 | As a configuration file when you create a new L<Log::Message> object. | |
129 | (The config will then only apply to that object if you marked it as | |
130 | private) | |
131 | ||
132 | =item * | |
133 | ||
134 | As arguments when you create a new Log::Message object. | |
135 | ||
136 | You should never need to use the L<Log::Message::Config> module yourself, | |
137 | as this is transparently done by L<Log::Message>, but its manpage does | |
138 | provide an explanation of how you can create a config file. | |
139 | ||
140 | =back | |
141 | ||
142 | =back | |
143 | ||
144 | =head1 Options | |
145 | ||
146 | When using Log::Message, or creating a new Log::Message object, you can | |
147 | supply various options to alter its behaviour. | |
148 | Of course, there are sensible defaults should you choose to omit these | |
149 | options. | |
150 | ||
151 | Below an explanation of all the options and how they work. | |
152 | ||
153 | =over 4 | |
154 | ||
155 | =item config | |
156 | ||
157 | The path to a configuration file to be read. | |
158 | See the manpage of L<Log::Message::Config> for the required format | |
159 | ||
160 | These options will be overridden by any explicit arguments passed. | |
161 | ||
162 | =item private | |
163 | ||
164 | Whether to create, by default, private or shared objects. | |
165 | If you choose to create shared objects, all Log::Message objects will | |
166 | use the same stack. | |
167 | ||
168 | This means that even though every module may make its own $log object | |
169 | they will still be sharing the same error stack on which they are | |
170 | putting errors and from which they are retrieving. | |
171 | ||
172 | This can be useful in big projects. | |
173 | ||
174 | If you choose to create a private object, then the stack will of | |
175 | course be private to this object, but it will still fall back to the | |
176 | shared config should no private config or overriding arguments be | |
177 | provided. | |
178 | ||
179 | =item verbose | |
180 | ||
181 | Log::Message makes use of another module to validate its arguments, | |
182 | which is called L<Params::Check>, which is a lightweight, yet | |
183 | powerful input checker and parser. (See the L<Params::Check> | |
184 | manpage for details). | |
185 | ||
186 | The verbose setting will control whether this module will | |
187 | generate warnings if something improper is passed as input, or merely | |
188 | silently returns undef, at which point Log::Message will generate a | |
189 | warning. | |
190 | ||
191 | It's best to just leave this at its default value, which is '1' | |
192 | ||
193 | =item tag | |
194 | ||
195 | The tag to add to messages if none was provided. If neither your | |
196 | config, nor any specific arguments supply a tag, then Log::Message will | |
197 | set it to 'NONE' | |
198 | ||
199 | Tags are useful for searching on or grouping by. For example, you | |
200 | could tag all the messages you want to go to the user as 'USER ERROR' | |
201 | and all those that are only debug information with 'DEBUG'. | |
202 | ||
203 | At the end of your program, you could then print all the ones tagged | |
204 | 'USER ERROR' to STDOUT, and those marked 'DEBUG' to a log file. | |
205 | ||
206 | =item level | |
207 | ||
208 | C<level> describes what action to take when a message is logged. Just | |
209 | like C<tag>, Log::Message will provide a default (which is 'log') if | |
210 | neither your config file, nor any explicit arguments are given to | |
211 | override it. | |
212 | ||
213 | See the Log::Message::Handlers manpage to see what handlers are | |
214 | available by default and what they do, as well as to how to add your | |
215 | own handlers. | |
216 | ||
217 | =item remove | |
218 | ||
219 | This indicates whether or not to automatically remove the messages | |
220 | from the stack when you've retrieved them. | |
221 | The default setting provided by Log::Message is '0': do not remove. | |
222 | ||
223 | =item chrono | |
224 | ||
225 | This indicates whether messages should always be fetched in | |
226 | chronological order or not. | |
227 | This simply means that you can choose whether, when retrieving items, | |
228 | the item most recently added should be returned first, or the one that | |
229 | had been added most long ago. | |
230 | ||
231 | The default is to return the newest ones first | |
232 | ||
233 | =back | |
234 | ||
235 | =cut | |
236 | ||
237 | ||
238 | ### subs ### | |
239 | sub import { | |
240 | my $pkg = shift; | |
241 | my %hash = @_; | |
242 | ||
243 | $CONFIG = new Log::Message::Config( %hash ) | |
244 | or die loc(qq[Problem initialising %1], __PACKAGE__); | |
245 | ||
246 | } | |
247 | ||
248 | =head1 Methods | |
249 | ||
250 | =head2 new | |
251 | ||
252 | This creates a new Log::Message object; The parameters it takes are | |
253 | described in the C<Options> section below and let it just be repeated | |
254 | that you can use these options like this: | |
255 | ||
256 | my $log = Log::Message->new( %options ); | |
257 | ||
258 | as well as during C<use> time, like this: | |
259 | ||
260 | use Log::Message option1 => value, option2 => value | |
261 | ||
262 | There are but 3 rules to keep in mind: | |
263 | ||
264 | =over 4 | |
265 | ||
266 | =item * | |
267 | ||
268 | Provided arguments take precedence over a configuration file. | |
269 | ||
270 | =item * | |
271 | ||
272 | Arguments to new take precedence over options provided at C<use> time | |
273 | ||
274 | =item * | |
275 | ||
276 | An object marked private will always have an empty stack to begin with | |
277 | ||
278 | =back | |
279 | ||
280 | =cut | |
281 | ||
282 | sub new { | |
283 | my $class = shift; | |
284 | my %hash = @_; | |
285 | ||
286 | my $conf = new Log::Message::Config( %hash, default => $CONFIG ) or return undef; | |
287 | ||
288 | if( $conf->private || $CONFIG->private ) { | |
289 | ||
290 | return _new_stack( $class, config => $conf ); | |
291 | ||
292 | } else { | |
293 | my $obj = _new_stack( $class, config => $conf, stack => $STACK ); | |
294 | ||
295 | ### if it was an empty stack, this was the first object | |
296 | ### in that case, set the global stack to match it for | |
297 | ### subsequent new, non-private objects | |
298 | $STACK = $obj->{STACK} unless scalar @$STACK; | |
299 | ||
300 | return $obj; | |
301 | } | |
302 | } | |
303 | ||
304 | sub _new_stack { | |
305 | my $class = shift; | |
306 | my %hash = @_; | |
307 | ||
308 | my $tmpl = { | |
309 | stack => { default => [] }, | |
310 | config => { default => bless( {}, 'Log::Message::Config'), | |
311 | required => 1, | |
312 | strict_type => 1 | |
313 | }, | |
314 | }; | |
315 | ||
316 | my $args = check( $tmpl, \%hash, $CONFIG->verbose ) or ( | |
317 | warn(loc(q[Could not create a new stack object: %1], | |
318 | Params::Check->last_error) | |
319 | ), | |
320 | return | |
321 | ); | |
322 | ||
323 | ||
324 | my %self = map { uc, $args->{$_} } keys %$args; | |
325 | ||
326 | return bless \%self, $class; | |
327 | } | |
328 | ||
329 | sub _get_conf { | |
330 | my $self = shift; | |
331 | my $what = shift; | |
332 | ||
333 | return defined $self->{CONFIG}->$what() | |
334 | ? $self->{CONFIG}->$what() | |
335 | : defined $CONFIG->$what() | |
336 | ? $CONFIG->$what() | |
337 | : undef; # should never get here | |
338 | } | |
339 | ||
340 | =head2 store | |
341 | ||
342 | This will create a new Item object and store it on the stack. | |
343 | ||
344 | Possible arguments you can give to it are: | |
345 | ||
346 | =over 4 | |
347 | ||
348 | =item message | |
349 | ||
350 | This is the only argument that is required. If no other arguments | |
351 | are given, you may even leave off the C<message> key. The argument | |
352 | will then automatically be assumed to be the message. | |
353 | ||
354 | =item tag | |
355 | ||
356 | The tag to add to this message. If not provided, Log::Message will look | |
357 | in your configuration for one. | |
358 | ||
359 | =item level | |
360 | ||
361 | The level at which this message should be handled. If not provided, | |
362 | Log::Message will look in your configuration for one. | |
363 | ||
364 | =item extra | |
365 | ||
366 | This is an array ref with arguments passed to the handler for this | |
367 | message, when it is called from store(); | |
368 | ||
369 | The handler will receive them as a normal list | |
370 | ||
371 | =back | |
372 | ||
373 | store() will return true upon success and undef upon failure, as well | |
374 | as issue a warning as to why it failed. | |
375 | ||
376 | =cut | |
377 | ||
378 | ### should extra be stored in the item object perhaps for later retrieval? | |
379 | sub store { | |
380 | my $self = shift; | |
381 | my %hash = (); | |
382 | ||
383 | my $tmpl = { | |
384 | message => { | |
385 | default => '', | |
386 | strict_type => 1, | |
387 | required => 1, | |
388 | }, | |
389 | tag => { default => $self->_get_conf('tag') }, | |
390 | level => { default => $self->_get_conf('level'), }, | |
391 | extra => { default => [], strict_type => 1 }, | |
392 | }; | |
393 | ||
394 | ### single arg means just the message | |
395 | ### otherwise, they are named | |
396 | if( @_ == 1 ) { | |
397 | $hash{message} = shift; | |
398 | } else { | |
399 | %hash = @_; | |
400 | } | |
401 | ||
402 | my $args = check( $tmpl, \%hash ) or ( | |
403 | warn( loc(q[Could not store error: %1], Params::Check->last_error) ), | |
404 | return | |
405 | ); | |
406 | ||
407 | my $extra = delete $args->{extra}; | |
408 | my $item = Log::Message::Item->new( %$args, | |
409 | parent => $self, | |
410 | id => scalar @{$self->{STACK}} | |
411 | ) | |
412 | or ( warn( loc(q[Could not create new log item!]) ), return undef ); | |
413 | ||
414 | push @{$self->{STACK}}, $item; | |
415 | ||
416 | { no strict 'refs'; | |
417 | ||
418 | my $sub = $args->{level}; | |
419 | ||
420 | $item->$sub( @$extra ); | |
421 | } | |
422 | ||
423 | return 1; | |
424 | } | |
425 | ||
426 | =head2 retrieve | |
427 | ||
428 | This will retrieve all message items matching the criteria specified | |
429 | from the stack. | |
430 | ||
431 | Here are the criteria you can discriminate on: | |
432 | ||
433 | =over 4 | |
434 | ||
435 | =item tag | |
436 | ||
437 | A regex to which the tag must adhere. For example C<qr/\w/>. | |
438 | ||
439 | =item level | |
440 | ||
441 | A regex to which the level must adhere. | |
442 | ||
443 | =item message | |
444 | ||
445 | A regex to which the message must adhere. | |
446 | ||
447 | =item amount | |
448 | ||
449 | Maximum amount of errors to return | |
450 | ||
451 | =item chrono | |
452 | ||
453 | Return in chronological order, or not? | |
454 | ||
455 | =item remove | |
456 | ||
457 | Remove items from the stack upon retrieval? | |
458 | ||
459 | =back | |
460 | ||
461 | In scalar context it will return the first item matching your criteria | |
462 | and in list context, it will return all of them. | |
463 | ||
464 | If an error occurs while retrieving, a warning will be issued and | |
465 | undef will be returned. | |
466 | ||
467 | =cut | |
468 | ||
469 | sub retrieve { | |
470 | my $self = shift; | |
471 | my %hash = (); | |
472 | ||
473 | my $tmpl = { | |
474 | tag => { default => qr/.*/ }, | |
475 | level => { default => qr/.*/ }, | |
476 | message => { default => qr/.*/ }, | |
477 | amount => { default => '' }, | |
478 | remove => { default => $self->_get_conf('remove') }, | |
479 | chrono => { default => $self->_get_conf('chrono') }, | |
480 | }; | |
481 | ||
482 | ### single arg means just the amount | |
483 | ### otherwise, they are named | |
484 | if( @_ == 1 ) { | |
485 | $hash{amount} = shift; | |
486 | } else { | |
487 | %hash = @_; | |
488 | } | |
489 | ||
490 | my $args = check( $tmpl, \%hash ) or ( | |
491 | warn( loc(q[Could not parse input: %1], Params::Check->last_error) ), | |
492 | return | |
493 | ); | |
494 | ||
495 | my @list = | |
496 | grep { $_->tag =~ /$args->{tag}/ ? 1 : 0 } | |
497 | grep { $_->level =~ /$args->{level}/ ? 1 : 0 } | |
498 | grep { $_->message =~ /$args->{message}/ ? 1 : 0 } | |
499 | grep { defined } | |
500 | $args->{chrono} | |
501 | ? @{$self->{STACK}} | |
502 | : reverse @{$self->{STACK}}; | |
503 | ||
504 | my $amount = $args->{amount} || scalar @list; | |
505 | ||
506 | my @rv = map { | |
507 | $args->{remove} ? $_->remove : $_ | |
508 | } scalar @list > $amount | |
509 | ? splice(@list,0,$amount) | |
510 | : @list; | |
511 | ||
512 | return wantarray ? @rv : $rv[0]; | |
513 | } | |
514 | ||
515 | =head2 first | |
516 | ||
517 | This is a shortcut for retrieving the first item(s) stored on the | |
518 | stack. It will default to only retrieving one if called with no | |
519 | arguments, and will always return results in chronological order. | |
520 | ||
521 | If you only supply one argument, it is assumed to be the amount you | |
522 | wish returned. | |
523 | ||
524 | Furthermore, it can take the same arguments as C<retrieve> can. | |
525 | ||
526 | =cut | |
527 | ||
528 | sub first { | |
529 | my $self = shift; | |
530 | ||
531 | my $amt = @_ == 1 ? shift : 1; | |
532 | return $self->retrieve( amount => $amt, @_, chrono => 1 ); | |
533 | } | |
534 | ||
535 | =head2 last | |
536 | ||
537 | This is a shortcut for retrieving the last item(s) stored on the | |
538 | stack. It will default to only retrieving one if called with no | |
539 | arguments, and will always return results in reverse chronological | |
540 | order. | |
541 | ||
542 | If you only supply one argument, it is assumed to be the amount you | |
543 | wish returned. | |
544 | ||
545 | Furthermore, it can take the same arguments as C<retrieve> can. | |
546 | ||
547 | =cut | |
548 | ||
549 | sub final { | |
550 | my $self = shift; | |
551 | ||
552 | my $amt = @_ == 1 ? shift : 1; | |
553 | return $self->retrieve( amount => $amt, @_, chrono => 0 ); | |
554 | } | |
555 | ||
556 | =head2 flush | |
557 | ||
558 | This removes all items from the stack and returns them to the caller | |
559 | ||
560 | =cut | |
561 | ||
562 | sub flush { | |
563 | my $self = shift; | |
564 | ||
565 | return splice @{$self->{STACK}}; | |
566 | } | |
567 | ||
568 | =head1 SEE ALSO | |
569 | ||
570 | L<Log::Message::Item>, L<Log::Message::Handlers>, L<Log::Message::Config> | |
571 | ||
572 | =head1 AUTHOR | |
573 | ||
574 | This module by | |
575 | Jos Boumans E<lt>kane@cpan.orgE<gt>. | |
576 | ||
577 | =head1 Acknowledgements | |
578 | ||
579 | Thanks to Ann Barcomb for her suggestions. | |
580 | ||
581 | =head1 COPYRIGHT | |
582 | ||
583 | This module is | |
584 | copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>. | |
585 | All rights reserved. | |
586 | ||
587 | This library is free software; | |
588 | you may redistribute and/or modify it under the same | |
589 | terms as Perl itself. | |
590 | ||
591 | =cut | |
592 | ||
593 | 1; | |
594 | ||
595 | # Local variables: | |
596 | # c-indentation-style: bsd | |
597 | # c-basic-offset: 4 | |
598 | # indent-tabs-mode: nil | |
599 | # End: | |
600 | # vim: expandtab shiftwidth=4: |