diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Log/Message.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Log/Message.pm | 599 |
1 files changed, 0 insertions, 599 deletions
diff --git a/Master/tlpkg/tlperl/lib/Log/Message.pm b/Master/tlpkg/tlperl/lib/Log/Message.pm deleted file mode 100644 index effcd133b9e..00000000000 --- a/Master/tlpkg/tlperl/lib/Log/Message.pm +++ /dev/null @@ -1,599 +0,0 @@ -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: |