summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Log/Message.pm
blob: effcd133b9edf1e86e2a0b38096b734609f578de (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
package Log::Message;
use if $] > 5.017, 'deprecate';

use strict;

use Params::Check qw[check];
use Log::Message::Item;
use Log::Message::Config;
use Locale::Maketext::Simple Style => 'gettext';

local $Params::Check::VERBOSE = 1;

BEGIN {
    use vars        qw[$VERSION @ISA $STACK $CONFIG];
    $VERSION    =   '0.06';
    $STACK      =   [];
}


=pod

=head1 NAME

Log::Message - A generic message storing mechanism;

=head1 SYNOPSIS

    use Log::Message private => 0, config => '/our/cf_file';

    my $log = Log::Message->new(    private => 1,
                                    level   => 'log',
                                    config  => '/my/cf_file',
                               );

    $log->store('this is my first message');

    $log->store(    message => 'message #2',
                    tag     => 'MY_TAG',
                    level   => 'carp',
                    extra   => ['this is an argument to the handler'],
               );

    my @last_five_items = $log->retrieve(5);

    my @items = $log->retrieve( tag     => qr/my_tag/i,
                                message => qr/\d/,
                                remove  => 1,
                              );

    my @items = $log->final( level => qr/carp/, amount => 2 );

    my $first_error = $log->first()

    # croak with the last error on the stack
    $log->final->croak;

    # empty the stack
    $log->flush();


=head1 DESCRIPTION

Log::Message is a generic message storage mechanism.
It allows you to store messages on a stack -- either shared or private
-- and assign meta-data to it.
Some meta-data will automatically be added for you, like a timestamp
and a stack trace, but some can be filled in by the user, like a tag
by which to identify it or group it, and a level at which to handle
the message (for example, log it, or die with it)

Log::Message also provides a powerful way of searching through items
by regexes on messages, tags and level.

=head1 Hierarchy

There are 4 modules of interest when dealing with the Log::Message::*
modules:

=over 4

=item Log::Message

Log::Message provides a few methods to manipulate the stack it keeps.
It has the option of keeping either a private or a public stack.
More on this below.

=item Log::Message::Item

These are individual message items, which are objects that contain
the user message as well as the meta-data described above.
See the L<Log::Message::Item> manpage to see how to extract this
meta-data and how to work with the Item objects.
You should never need to create your own Item objects, but knowing
about their methods and accessors is important if you want to write
your own handlers. (See below)

=item Log::Message::Handlers

These are a collection of handlers that will be called for a level
that is used on a L<Log::Message::Item> object.
For example, if a message is logged with the 'carp' level, the 'carp'
handler from L<Log::Message::Handlers> will be called.
See the L<Log::Message::Handlers> manpage for more explanation about how
handlers work, which one are available and how to create your own.

=item Log::Message::Config

Per Log::Message object, there is a configuration required that will
fill in defaults if the user did not specify arguments to override
them (like for example what tag will be set if none was provided),
L<Log::Message::Config> handles the creation of these configurations.

Configuration can be specified in 4 ways:

=over 4

=item *

As a configuration file when you C<use Log::Message>

=item *

As arguments when you C<use Log::Message>

=item *

As a configuration file when you create a new L<Log::Message> object.
(The config will then only apply to that object if you marked it as
private)

=item *

As arguments when you create a new Log::Message object.

You should never need to use the L<Log::Message::Config> module yourself,
as this is transparently done by L<Log::Message>, but its manpage does
provide an explanation of how you can create a config file.

=back

=back

=head1 Options

When using Log::Message, or creating a new Log::Message object, you can
supply various options to alter its behaviour.
Of course, there are sensible defaults should you choose to omit these
options.

Below an explanation of all the options and how they work.

=over 4

=item config

The path to a configuration file to be read.
See the manpage of L<Log::Message::Config> for the required format

These options will be overridden by any explicit arguments passed.

=item private

Whether to create, by default, private or shared objects.
If you choose to create shared objects, all Log::Message objects will
use the same stack.

This means that even though every module may make its own $log object
they will still be sharing the same error stack on which they are
putting errors and from which they are retrieving.

This can be useful in big projects.

If you choose to create a private object, then the stack will of
course be private to this object, but it will still fall back to the
shared config should no private config or overriding arguments be
provided.

=item verbose

Log::Message makes use of another module to validate its arguments,
which is called L<Params::Check>, which is a lightweight, yet
powerful input checker and parser. (See the L<Params::Check>
manpage for details).

The verbose setting will control whether this module will
generate warnings if something improper is passed as input, or merely
silently returns undef, at which point Log::Message will generate a
warning.

It's best to just leave this at its default value, which is '1'

=item tag

The tag to add to messages if none was provided. If neither your
config, nor any specific arguments supply a tag, then Log::Message will
set it to 'NONE'

Tags are useful for searching on or grouping by. For example, you
could tag all the messages you want to go to the user as 'USER ERROR'
and all those that are only debug information with 'DEBUG'.

At the end of your program, you could then print all the ones tagged
'USER ERROR' to STDOUT, and those marked 'DEBUG' to a log file.

=item level

C<level> describes what action to take when a message is logged. Just
like C<tag>, Log::Message will provide a default (which is 'log') if
neither your config file, nor any explicit arguments are given to
override it.

See the Log::Message::Handlers manpage to see what handlers are
available by default and what they do, as well as to how to add your
own handlers.

=item remove

This indicates whether or not to automatically remove the messages
from the stack when you've retrieved them.
The default setting provided by Log::Message is '0': do not remove.

=item chrono

This indicates whether messages should always be fetched in
chronological order or not.
This simply means that you can choose whether, when retrieving items,
the item most recently added should be returned first, or the one that
had been added most long ago.

The default is to return the newest ones first

=back

=cut


### subs ###
sub import {
    my $pkg     = shift;
    my %hash    = @_;

    $CONFIG = new Log::Message::Config( %hash )
                or die loc(qq[Problem initialising %1], __PACKAGE__);

}

=head1 Methods

=head2 new

This creates a new Log::Message object; The parameters it takes are
described in the C<Options> section below and let it just be repeated
that you can use these options like this:

    my $log = Log::Message->new( %options );

as well as during C<use> time, like this:

    use Log::Message option1 => value, option2 => value

There are but 3 rules to keep in mind:

=over 4

=item *

Provided arguments take precedence over a configuration file.

=item *

Arguments to new take precedence over options provided at C<use> time

=item *

An object marked private will always have an empty stack to begin with

=back

=cut

sub new {
    my $class   = shift;
    my %hash    = @_;

    my $conf = new Log::Message::Config( %hash, default => $CONFIG ) or return undef;

    if( $conf->private || $CONFIG->private ) {

        return _new_stack( $class, config => $conf );

    } else {
        my $obj = _new_stack( $class, config => $conf, stack => $STACK );

        ### if it was an empty stack, this was the first object
        ### in that case, set the global stack to match it for
        ### subsequent new, non-private objects
        $STACK = $obj->{STACK} unless scalar @$STACK;

        return $obj;
    }
}

sub _new_stack {
    my $class = shift;
    my %hash  = @_;

    my $tmpl = {
        stack   => { default        => [] },
        config  => { default        => bless( {}, 'Log::Message::Config'),
                     required       => 1,
                     strict_type    => 1
                },
    };

    my $args = check( $tmpl, \%hash, $CONFIG->verbose ) or (
        warn(loc(q[Could not create a new stack object: %1],
                Params::Check->last_error)
        ),
        return
    );


    my %self = map { uc, $args->{$_} } keys %$args;

    return bless \%self, $class;
}

sub _get_conf {
    my $self = shift;
    my $what = shift;

    return defined $self->{CONFIG}->$what()
                ?  $self->{CONFIG}->$what()
                :  defined $CONFIG->$what()
                        ?  $CONFIG->$what()
                        :  undef;           # should never get here
}

=head2 store

This will create a new Item object and store it on the stack.

Possible arguments you can give to it are:

=over 4

=item message

This is the only argument that is required. If no other arguments
are given, you may even leave off the C<message> key. The argument
will then automatically be assumed to be the message.

=item tag

The tag to add to this message. If not provided, Log::Message will look
in your configuration for one.

=item level

The level at which this message should be handled. If not provided,
Log::Message will look in your configuration for one.

=item extra

This is an array ref with arguments passed to the handler for this
message, when it is called from store();

The handler will receive them as a normal list

=back

store() will return true upon success and undef upon failure, as well
as issue a warning as to why it failed.

=cut

### should extra be stored in the item object perhaps for later retrieval?
sub store {
    my $self = shift;
    my %hash = ();

    my $tmpl = {
        message => {
                default     => '',
                strict_type => 1,
                required    => 1,
            },
        tag     => { default => $self->_get_conf('tag')     },
        level   => { default => $self->_get_conf('level'),  },
        extra   => { default => [], strict_type => 1 },
    };

    ### single arg means just the message
    ### otherwise, they are named
    if( @_ == 1 ) {
        $hash{message} = shift;
    } else {
        %hash = @_;
    }

    my $args = check( $tmpl, \%hash ) or (
        warn( loc(q[Could not store error: %1], Params::Check->last_error) ),
        return
    );

    my $extra = delete $args->{extra};
    my $item = Log::Message::Item->new(   %$args,
                                        parent  => $self,
                                        id      => scalar @{$self->{STACK}}
                                    )
            or ( warn( loc(q[Could not create new log item!]) ), return undef );

    push @{$self->{STACK}}, $item;

    {   no strict 'refs';

        my $sub = $args->{level};

        $item->$sub( @$extra );
    }

    return 1;
}

=head2 retrieve

This will retrieve all message items matching the criteria specified
from the stack.

Here are the criteria you can discriminate on:

=over 4

=item tag

A regex to which the tag must adhere. For example C<qr/\w/>.

=item level

A regex to which the level must adhere.

=item message

A regex to which the message must adhere.

=item amount

Maximum amount of errors to return

=item chrono

Return in chronological order, or not?

=item remove

Remove items from the stack upon retrieval?

=back

In scalar context it will return the first item matching your criteria
and in list context, it will return all of them.

If an error occurs while retrieving, a warning will be issued and
undef will be returned.

=cut

sub retrieve {
    my $self = shift;
    my %hash = ();

    my $tmpl = {
        tag     => { default => qr/.*/ },
        level   => { default => qr/.*/ },
        message => { default => qr/.*/ },
        amount  => { default => '' },
        remove  => { default => $self->_get_conf('remove')  },
        chrono  => { default => $self->_get_conf('chrono')  },
    };

    ### single arg means just the amount
    ### otherwise, they are named
    if( @_ == 1 ) {
        $hash{amount} = shift;
    } else {
        %hash = @_;
    }

    my $args = check( $tmpl, \%hash ) or (
        warn( loc(q[Could not parse input: %1], Params::Check->last_error) ),
        return
    );

    my @list =
            grep { $_->tag      =~ /$args->{tag}/       ? 1 : 0 }
            grep { $_->level    =~ /$args->{level}/     ? 1 : 0 }
            grep { $_->message  =~ /$args->{message}/   ? 1 : 0 }
            grep { defined }
                $args->{chrono}
                    ? @{$self->{STACK}}
                    : reverse @{$self->{STACK}};

    my $amount = $args->{amount} || scalar @list;

    my @rv = map {
                $args->{remove} ? $_->remove : $_
           } scalar @list > $amount
                            ? splice(@list,0,$amount)
                            : @list;

    return wantarray ? @rv : $rv[0];
}

=head2 first

This is a shortcut for retrieving the first item(s) stored on the
stack. It will default to only retrieving one if called with no
arguments, and will always return results in chronological order.

If you only supply one argument, it is assumed to be the amount you
wish returned.

Furthermore, it can take the same arguments as C<retrieve> can.

=cut

sub first {
    my $self = shift;

    my $amt = @_ == 1 ? shift : 1;
    return $self->retrieve( amount => $amt, @_, chrono => 1 );
}

=head2 last

This is a shortcut for retrieving the last item(s) stored on the
stack. It will default to only retrieving one if called with no
arguments, and will always return results in reverse chronological
order.

If you only supply one argument, it is assumed to be the amount you
wish returned.

Furthermore, it can take the same arguments as C<retrieve> can.

=cut

sub final {
    my $self = shift;

    my $amt = @_ == 1 ? shift : 1;
    return $self->retrieve( amount => $amt, @_, chrono => 0 );
}

=head2 flush

This removes all items from the stack and returns them to the caller

=cut

sub flush {
    my $self = shift;

    return splice @{$self->{STACK}};
}

=head1 SEE ALSO

L<Log::Message::Item>, L<Log::Message::Handlers>, L<Log::Message::Config>

=head1 AUTHOR

This module by
Jos Boumans E<lt>kane@cpan.orgE<gt>.

=head1 Acknowledgements

Thanks to Ann Barcomb for her suggestions.

=head1 COPYRIGHT

This module is
copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.
All rights reserved.

This library is free software;
you may redistribute and/or modify it under the same
terms as Perl itself.

=cut

1;

# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4: