Log-Message-0.08004075500017510000144000000000001213632630700125245ustar chrisusersLog-Message-0.08/CHANGES010064400017510000144000000015251213632617400136000ustar chrisusersChanges for 0.08 Thu Apr 25 23:20:08 BST 2013 ================================================= * Open configuration file for reading only. RT#84844 (Petr Pisar) Changes for 0.06 Wed Jan 23 12:21:48 GMT 2013 ================================================= * Add deprecate usage to warn if module is loaded from corelib. Log::Message is leaving core with v5.20.0, but will still be available from CPAN. Changes for 0.04 Fri Jan 7 21:41:00 GMT 2011 ================================================= * Apply blead patch from Peter Acklam Changes for 0.02 Sat Dec 13 18:35:01 CET 2008 ================================================= * Users of 0.01 need not upgrade * Log::Message is a core module, so the Makefile.PL should reflect this and install into the 'core' directory, instead of 'site' * Quell minor warning in t/02.t Log-Message-0.08/lib004075500017510000144000000000001213632630600132715ustar chrisusersLog-Message-0.08/lib/Log004075500017510000144000000000001213632630600140125ustar chrisusersLog-Message-0.08/lib/Log/Message004075500017510000144000000000001213632630600153765ustar chrisusersLog-Message-0.08/lib/Log/Message/Handlers.pm010064400017510000144000000072731213632601600175570ustar chrisuserspackage Log::Message::Handlers; use if $] > 5.017, 'deprecate'; use strict; use vars qw[$VERSION]; $VERSION = '0.08'; =pod =head1 NAME Log::Message::Handlers - Message handlers for Log::Message =head1 SYNOPSIS # Implicitly used by Log::Message to serve as handlers for # Log::Message::Item objects # Create your own file with a package called # Log::Message::Handlers to add to the existing ones, or to even # overwrite them $item->carp; $item->trace; =head1 DESCRIPTION Log::Message::Handlers provides handlers for Log::Message::Item objects. The handler corresponding to the level (see Log::Message::Item manpage for an explanation about levels) will be called automatically upon storing the error. Handlers may also explicitly be called on an Log::Message::Item object if one so desires (see the Log::Message manpage on how to retrieve the Item objects). =head1 Default Handlers =head2 log Will simply log the error on the stack, and do nothing special =cut sub log { 1 } =head2 carp Will carp (see the Carp manpage) with the error, and add the timestamp of when it occurred. =cut sub carp { my $self = shift; warn join " ", $self->message, $self->shortmess, 'at', $self->when, "\n"; } =head2 croak Will croak (see the Carp manpage) with the error, and add the timestamp of when it occurred. =cut sub croak { my $self = shift; die join " ", $self->message, $self->shortmess, 'at', $self->when, "\n"; } =head2 cluck Will cluck (see the Carp manpage) with the error, and add the timestamp of when it occurred. =cut sub cluck { my $self = shift; warn join " ", $self->message, $self->longmess, 'at', $self->when, "\n"; } =head2 confess Will confess (see the Carp manpage) with the error, and add the timestamp of when it occurred =cut sub confess { my $self = shift; die join " ", $self->message, $self->longmess, 'at', $self->when, "\n"; } =head2 die Will simply die with the error message of the item =cut sub die { die shift->message; } =head2 warn Will simply warn with the error message of the item =cut sub warn { warn shift->message; } =head2 trace Will provide a traceback of this error item back to the first one that occurred, clucking with every item as it comes across it. =cut sub trace { my $self = shift; for my $item( $self->parent->retrieve( chrono => 0 ) ) { $item->cluck; } } =head1 Custom Handlers If you wish to provide your own handlers, you can simply do the following: =over 4 =item * Create a file that holds a package by the name of C =item * Create subroutines with the same name as the levels you wish to handle in the Log::Message module (see the Log::Message manpage for explanation on levels) =item * Require that file in your program, or add it in your configuration (see the Log::Message::Config manpage for explanation on how to use a config file) =back And that is it, the handler will now be available to handle messages for you. The arguments a handler may receive are those specified by the C key, when storing the message. See the Log::Message manpage for details on the arguments. =head1 SEE ALSO L, L, L =head1 AUTHOR This module by Jos Boumans Ekane@cpan.orgE. =head1 Acknowledgements Thanks to Ann Barcomb for her suggestions. =head1 COPYRIGHT This module is copyright (c) 2002 Jos Boumans Ekane@cpan.orgE. 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: Log-Message-0.08/lib/Log/Message/Config.pm010064400017510000144000000117241213632601600172200ustar chrisuserspackage Log::Message::Config; use if $] > 5.017, 'deprecate'; use strict; use Params::Check qw[check]; use Module::Load; use FileHandle; use Locale::Maketext::Simple Style => 'gettext'; BEGIN { use vars qw[$VERSION $AUTOLOAD]; $VERSION = '0.08'; } sub new { my $class = shift; my %hash = @_; ### find out if the user specified a config file to use ### and/or a default configuration object ### and remove them from the argument hash my %special = map { lc, delete $hash{$_} } grep /^config|default$/i, keys %hash; ### allow provided arguments to override the values from the config ### my $tmpl = { private => { default => undef, }, verbose => { default => 1 }, tag => { default => 'NONE', }, level => { default => 'log', }, remove => { default => 0 }, chrono => { default => 1 }, }; my %lc_hash = map { lc, $hash{$_} } keys %hash; my $file_conf; if( $special{config} ) { $file_conf = _read_config_file( $special{config} ) or ( warn( loc(q[Could not parse config file!]) ), return ); } my $def_conf = \%{ $special{default} || {} }; ### make sure to only include keys that are actually defined -- ### the checker will assign even 'undef' if you have provided that ### as a value ### priorities goes as follows: ### 1: arguments passed ### 2: any config file passed ### 3: any default config passed my %to_check = map { @$_ } grep { defined $_->[1] } map { [ $_ => defined $lc_hash{$_} ? $lc_hash{$_} : defined $file_conf->{$_} ? $file_conf->{$_} : defined $def_conf->{$_} ? $def_conf->{$_} : undef ] } keys %$tmpl; my $rv = check( $tmpl, \%to_check, 1 ) or ( warn( loc(q[Could not validate arguments!]) ), return ); return bless $rv, $class; } sub _read_config_file { my $file = shift or return; my $conf = {}; my $FH = new FileHandle; $FH->open("$file", 'r') or ( warn(loc(q[Could not open config file '%1': %2],$file,$!)), return {} ); while(<$FH>) { next if /\s*#/; next unless /\S/; chomp; s/^\s*//; s/\s*$//; my ($param,$val) = split /\s*=\s*/; if( (lc $param) eq 'include' ) { load $val; next; } ### add these to the config hash ### $conf->{ lc $param } = $val; } close $FH; return $conf; } sub AUTOLOAD { $AUTOLOAD =~ s/.+:://; my $self = shift; return $self->{ lc $AUTOLOAD } if exists $self->{ lc $AUTOLOAD }; die loc(q[No such accessor '%1' for class '%2'], $AUTOLOAD, ref $self); } sub DESTROY { 1 } 1; __END__ =pod =head1 NAME Log::Message::Config - Configuration options for Log::Message =head1 SYNOPSIS # This module is implicitly used by Log::Message to create a config # which it uses to log messages. # For the options you can pass, see the C method. # Below is a sample of a config file you could use # comments are denoted by a single '#' # use a shared stack, or have a private instance? # if none provided, set to '0', private = 1 # do not be verbose verbose = 0 # default tag to set on new items # if none provided, set to 'NONE' tag = SOME TAG # default level to handle items # if none provided, set to 'log' level = carp # extra files to include # if none provided, no files are auto included include = mylib.pl include = ../my/other/lib.pl # automatically delete items # when you retrieve them from the stack? # if none provided, set to '0' remove = 1 # retrieve errors in chronological order, or not? # if none provided, set to '1' chrono = 0 =head1 DESCRIPTION Log::Message::Config provides a standardized config object for Log::Message objects. It can either read options as perl arguments, or as a config file. See the Log::Message manpage for more information about what arguments are valid, and see the Synopsis for an example config file you can use =head1 SEE ALSO L, L, L =head1 AUTHOR This module by Jos Boumans Ekane@cpan.orgE. =head1 Acknowledgements Thanks to Ann Barcomb for her suggestions. =head1 COPYRIGHT This module is copyright (c) 2002 Jos Boumans Ekane@cpan.orgE. All rights reserved. This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 # indent-tabs-mode: nil # End: # vim: expandtab shiftwidth=4: Log-Message-0.08/lib/Log/Message/Item.pm010064400017510000144000000112301213632601600167010ustar chrisuserspackage Log::Message::Item; use if $] > 5.017, 'deprecate'; use strict; use vars qw[$VERSION]; use Params::Check qw[check]; use Log::Message::Handlers; ### for the messages to store ### use Carp (); BEGIN { use vars qw[$AUTOLOAD $VERSION]; $VERSION = '0.08'; } ### create a new item. ### note that only an id (position on the stack), message and a reference ### to its parent are required. all the other things it can fill in itself sub new { my $class = shift; my %hash = @_; my $tmpl = { when => { no_override => 1, default => scalar localtime }, id => { required => 1 }, message => { required => 1 }, parent => { required => 1 }, level => { default => '' }, # default may be conf dependant tag => { default => '' }, # default may be conf dependant longmess => { default => _clean(Carp::longmess()) }, shortmess => { default => _clean(Carp::shortmess())}, }; my $args = check($tmpl, \%hash) or return undef; return bless $args, $class; } sub _clean { map { s/\s*//; chomp; $_ } shift; } sub remove { my $item = shift; my $self = $item->parent; return splice( @{$self->{STACK}}, $item->id, 1, undef ); } sub AUTOLOAD { my $self = $_[0]; $AUTOLOAD =~ s/.+:://; return $self->{$AUTOLOAD} if exists $self->{$AUTOLOAD}; local $Carp::CarpLevel = $Carp::CarpLevel + 3; { no strict 'refs'; return *{"Log::Message::Handlers::${AUTOLOAD}"}->(@_); } } sub DESTROY { 1 } 1; __END__ =pod =head1 NAME Log::Message::Item - Message objects for Log::Message =head1 SYNOPSIS # Implicitly used by Log::Message to create Log::Message::Item objects print "this is the message's id: ", $item->id; print "this is the message stored: ", $item->message; print "this is when it happened: ", $item->when; print "the message was tagged: ", $item->tag; print "this was the severity level: ", $item->level; $item->remove; # delete the item from the stack it was on # Besides these methods, you can also call the handlers on # the object specifically. # See the Log::Message::Handlers manpage for documentation on what # handlers are available by default and how to add your own =head1 DESCRIPTION Log::Message::Item is a class that generates generic Log items. These items are stored on a Log::Message stack, so see the Log::Message manpage about details how to retrieve them. You should probably not create new items by yourself, but use the storing mechanism provided by Log::Message. However, the accessors and handlers are of interest if you want to do fine tuning of how your messages are handled. The accessors and methods are described below, the handlers are documented in the Log::Message::Handlers manpage. =head1 Methods and Accessors =head2 remove Calling remove will remove the object from the stack it was on, so it will not show up any more in subsequent fetches of messages. You can still call accessors and handlers on it however, to handle it as you will. =head2 id Returns the internal ID of the item. This may be useful for comparing since the ID is incremented each time a new item is created. Therefore, an item with ID 4 must have been logged before an item with ID 9. =head2 when Returns the timestamp of when the message was logged =head2 message The actual message that was stored =head2 level The severity type of this message, as well as the name of the handler that was called upon storing it. =head2 tag Returns the identification tag that was put on the message. =head2 shortmess Returns the equivalent of a C for this item. See the C manpage for details. =head2 longmess Returns the equivalent of a C for this item, which is essentially a stack trace. See the C manpage for details. =head2 parent Returns a reference to the Log::Message object that stored this item. This is useful if you want to have access to the full stack in a handler. =head1 SEE ALSO L, L, L =head1 AUTHOR This module by Jos Boumans Ekane@cpan.orgE. =head1 Acknowledgements Thanks to Ann Barcomb for her suggestions. =head1 COPYRIGHT This module is copyright (c) 2002 Jos Boumans Ekane@cpan.orgE. All rights reserved. This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 # indent-tabs-mode: nil # End: # vim: expandtab shiftwidth=4: Log-Message-0.08/lib/Log/Message.pm010064400017510000144000000357221213632601600160170ustar chrisuserspackage 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.08'; $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 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 object. For example, if a message is logged with the 'carp' level, the 'carp' handler from L will be called. See the L 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 handles the creation of these configurations. Configuration can be specified in 4 ways: =over 4 =item * As a configuration file when you C =item * As arguments when you C =item * As a configuration file when you create a new L 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 module yourself, as this is transparently done by L, 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 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, which is a lightweight, yet powerful input checker and parser. (See the L 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 describes what action to take when a message is logged. Just like C, 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 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 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 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 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. =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 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 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, L, L =head1 AUTHOR This module by Jos Boumans Ekane@cpan.orgE. =head1 Acknowledgements Thanks to Ann Barcomb for her suggestions. =head1 COPYRIGHT This module is copyright (c) 2002 Jos Boumans Ekane@cpan.orgE. 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: Log-Message-0.08/t004075500017510000144000000000001213632630600127665ustar chrisusersLog-Message-0.08/t/01_Log-Message-Config.t010064400017510000144000000035611207771655700170610ustar chrisusers### Log::Message::Config test suite ### BEGIN { if( $ENV{PERL_CORE} ) { chdir '../lib/Log/Message' if -d '../lib/Log/Message'; unshift @INC, '../../..'; } } BEGIN { chdir 't' if -d 't' } use strict; use lib qw[../lib conf]; use Test::More tests => 6; use File::Spec; use File::Basename qw[dirname]; use_ok( 'Log::Message::Config' ) or diag "Config.pm not found. Dying", die; use_ok( 'Log::Message' ) or diag "Module.pm not found. Dying", die; { my $default = { private => undef, verbose => 1, tag => 'NONE', level => 'log', remove => 0, chrono => 1, }; my $log = Log::Message->new(); is_deeply( $default, $log->{CONFIG}, q[Config creation from default] ); } { my $config = { private => 1, verbose => 1, tag => 'TAG', level => 'carp', remove => 0, chrono => 1, }; my $log = Log::Message->new( %$config ); is_deeply( $config, $log->{CONFIG}, q[Config creation from options] ); } { my $file = { private => 1, verbose => 0, tag => 'SOME TAG', level => 'carp', remove => 1, chrono => 0, }; my $log = Log::Message->new( config => File::Spec->catfile( qw|conf config_file| ) ); is_deeply( $file, $log->{CONFIG}, q[Config creation from file] ); } { my $mixed = { private => 1, verbose => 0, remove => 1, chrono => 0, tag => 'MIXED', level => 'die', }; my $log = Log::Message->new( config => File::Spec->catfile( qw|conf config_file| ), tag => 'MIXED', level => 'die', ); is_deeply( $mixed, $log->{CONFIG}, q[Config creation from file & options] ); } Log-Message-0.08/t/conf004075500017510000144000000000001213632630600137135ustar chrisusersLog-Message-0.08/t/conf/config_file010064400017510000144000000014031207771655700161730ustar chrisusers # Below is a sample of a config file you could use # comments are denoted by a single '#' # use a shared stack, or have a private instance? # if none provided, set to '0', private = 1 # do not be verbose verbose = 0 # default tag to set on new items # if none provided, set to 'NONE' tag = SOME TAG # default level to handle items # if none provided, set to 'log' level = carp # extra files to include # if none provided, no files are auto included include = LoadMe.pl # automatically delete items # when you retrieve them from the stack? # if none provided, set to '0' remove = 1 # retrieve errors in chronological order, or not? # if none provided, set to '1' chrono = 0Log-Message-0.08/t/conf/LoadMe.pl010064400017510000144000000000021207771655700154740ustar chrisusers1;Log-Message-0.08/t/02_Log-Message.t010064400017510000144000000107021207771655700156520ustar chrisusers### Log::Message test suite ### BEGIN { if( $ENV{PERL_CORE} ) { chdir '../lib/Log/Message' if -d '../lib/Log/Message'; unshift @INC, '../../..'; } } BEGIN { chdir 't' if -d 't' } use strict; use lib qw[../lib to_load]; use Test::More tests => 34; ### use tests for my $pkg ( qw[ Log::Message Log::Message::Config Log::Message::Item Log::Message::Handlers] ) { use_ok( $pkg ) or diag "'$pkg' not found. Dying"; } ### test global stack { my $log = Log::Message->new( private => 0 ); is( $log->{STACK}, $Log::Message::STACK, q[Using global stack] ); } ### test using private stack { my $log = Log::Message->new( private => 1 ); isnt( $log->{STACK}, $Log::Message::STACK, q[Using private stack] ); $log->store('foo'); $log->store('bar'); ### retrieval tests { my @list = $log->retrieve(); ok( @list == 2, q[Stored 2 messages] ); } $log->store('zot'); $log->store('quux'); { my @list = $log->retrieve( amount => 3 ); ok( @list == 3, q[Retrieving 3 messages] ); } { is( $log->first->message, 'foo', q[ Retrieving first message] ); is( $log->final->message, 'quux', q[ Retrieving final message] ); } { package Log::Message::Handlers; sub test { return shift } sub test2 { shift; return @_ } package main; } $log->store( message => 'baz', tag => 'MY TAG', level => 'test', ); { ok( $log->retrieve( message => qr/baz/ ), q[ Retrieving based on message] ); ok( $log->retrieve( tag => qr/TAG/ ), q[ Retrieving based on tag] ); ok( $log->retrieve( level => qr/test/ ), q[ Retrieving based on level] ); } my $item = $log->retrieve( chrono => 0 ); { ok( $item, q[Retrieving item] ); is( $item->parent, $log, q[ Item reference to parent] ); is( $item->message, 'baz', q[ Item message stored] ); is( $item->id, 4, q[ Item id stored] ); is( $item->tag, 'MY TAG', q[ Item tag stored] ); is( $item->level, 'test', q[ Item level stored] ); } { ### shortmess is very different from 5.6.1 => 5.8, so let's ### just check that it is filled. ok( $item->shortmess, q[Item shortmess stored] ); like( $item->shortmess, qr/\w+/, q[ Item shortmess stored properly] ); ok( $item->longmess, q[Item longmess stored] ); like( $item->longmess, qr/Log::Message::store/s, q[ Item longmess stored properly] ); my $t = scalar localtime; $t =~ /(\w+ \w+ \d+)/; like( $item->when, qr/$1/, q[Item timestamp stored] ); } { my $i = $item->test; my @a = $item->test2(1,2,3); is( $item, $i, q[Item handler check] ); is_deeply( $item, $i, q[ Item handler deep check] ); is_deeply( \@a, [1,2,3], q[ Item extra argument check] ); } { ok( $item->remove, q[Removing item from stack] ); ok( (!grep{ $item eq $_ } $log->retrieve), q[ Item removed from stack] ); } { $log->flush; ok( @{$log->{STACK}} == 0, q[Flushing stack] ); } } ### test errors { my $log = Log::Message->new( private => 1 ); ### store errors { ### dont make it print my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" }; my $rv = $log->store(); ok( !$rv, q[Logging empty message failed] ); like( $warnings, qr/message/, q[ Spotted the error] ); } ### retrieve errors { ### dont make it print my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" }; ### XXX whitebox test! local $Params::Check::VERBOSE = 1; # so the warnings are emitted local $Params::Check::VERBOSE = 1; # so the warnings are emitted my $rv = $log->retrieve( frobnitz => $$ ); ok( !$rv, q[Retrieval with bogus args] ); like( $warnings, qr/not a valid key/, qq[ Spotted the error] ); } } Log-Message-0.08/MANIFEST010064400017510000144000000005761213632630700137410ustar chrisusersCHANGES lib/Log/Message.pm lib/Log/Message/Config.pm lib/Log/Message/Handlers.pm lib/Log/Message/Item.pm Makefile.PL MANIFEST README t/01_Log-Message-Config.t t/02_Log-Message.t t/conf/config_file t/conf/LoadMe.pl META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Log-Message-0.08/Makefile.PL010064400017510000144000000037431207771655700145770ustar chrisusersuse ExtUtils::MakeMaker; use strict; WriteMakefile1( LICENSE => 'perl', META_MERGE => { resources => { repository => 'git://github.com/jib/log-message.git', }, }, NAME => 'Log::Message', VERSION_FROM => 'lib/Log/Message.pm', # finds $VERSION dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz' }, PREREQ_PM => { 'Test::More' => 0, 'Params::Check' => 0, 'Module::Load' => 0, 'File::Spec' => 0, 'Locale::Maketext::Simple', => 0, 'if' => 0, }, INSTALLDIRS => ( $] >= 5.009005 && $] < 5.012 ? 'perl' : 'site' ), AUTHOR => 'Jos Boumans ', ABSTRACT => 'Powerful and flexible message logging mechanism', ); sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade. my %params=@_; my $eumm_version=$ExtUtils::MakeMaker::VERSION; $eumm_version=eval $eumm_version; die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; die "License not specified" if not exists $params{LICENSE}; if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { #EUMM 6.5502 has problems with BUILD_REQUIRES $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; delete $params{BUILD_REQUIRES}; } delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; delete $params{META_MERGE} if $eumm_version < 6.46; delete $params{META_ADD} if $eumm_version < 6.46; delete $params{LICENSE} if $eumm_version < 6.31; delete $params{AUTHOR} if $] < 5.005; delete $params{ABSTRACT_FROM} if $] < 5.005; delete $params{BINARY_LOCATION} if $] < 5.005; WriteMakefile(%params); } Log-Message-0.08/README010064400017510000144000000022621207771655700135000ustar chrisusersThis is the README file for Log::Message, a small and powerful generic message logging module. Please type "perldoc Log::Message" after installation to see the module usage information. ##################################################################### * Description Log::Message This module enables you to do generic message logging throughout programs and projects. Every message will be logged with stacktraces, timestamps and so on. You can use built-in handlers immediately, or after the fact when you inspect the error stack. It is highly configurable and let's you even provide your own handlers for dealing with messages. ##################################################################### * Installation Log::Message uses the standard perl module install process: perl Makefile.PL make make test make install ###################################################################### AUTHOR This module by Jos Boumans . COPYRIGHT This module is copyright (c) 2002 Jos Boumans . All rights reserved. This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. Log-Message-0.08/META.yml010064400017510000144000000012211213632630700140450ustar chrisusers--- abstract: 'Powerful and flexible message logging mechanism' author: - 'Jos Boumans ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.130880' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Log-Message no_index: directory: - t - inc requires: File::Spec: 0 Locale::Maketext::Simple: 0 Module::Load: 0 Params::Check: 0 Test::More: 0 if: 0 resources: repository: git://github.com/jib/log-message.git version: 0.08 Log-Message-0.08/META.json010064400017510000144000000022271213632630700142240ustar chrisusers{ "abstract" : "Powerful and flexible message logging mechanism", "author" : [ "Jos Boumans " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.130880", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Log-Message", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "File::Spec" : "0", "Locale::Maketext::Simple" : "0", "Module::Load" : "0", "Params::Check" : "0", "Test::More" : "0", "if" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "git://github.com/jib/log-message.git" } }, "version" : "0.08" }