Commit | Line | Data |
e3f7a951 |
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 | |
4da9db91 |
15 | $VERSION = 0.02; |
e3f7a951 |
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 | More on this below. |
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: |