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