From e3f7a951231ee3b5fdd8b5bc09a32406aaecc2cd Mon Sep 17 00:00:00 2001 From: Rafael Garcia-Suarez Date: Tue, 28 Nov 2006 17:19:40 +0000 Subject: [PATCH] Remove DOS line endings (perforce should take care of line encodings on checkout) p4raw-id: //depot/perl@29411 --- lib/IPC/Cmd/t/02_Interactive.t | 220 ++-- lib/Log/Message.pm | 1200 ++++++++++---------- lib/Log/Message/Config.pm | 394 +++---- lib/Log/Message/Handlers.pm | 382 +++---- lib/Log/Message/Item.pm | 384 +++---- lib/Log/Message/t/conf/config_file | 60 +- lib/Module/Load/Conditional/t/to_load/Commented.pm | 8 +- lib/Module/Load/Conditional/t/to_load/LoadIt.pm | 6 +- .../Load/Conditional/t/to_load/Must/Be/Loaded.pm | 6 +- 9 files changed, 1330 insertions(+), 1330 deletions(-) diff --git a/lib/IPC/Cmd/t/02_Interactive.t b/lib/IPC/Cmd/t/02_Interactive.t index a8d48a0..333f9ff 100644 --- a/lib/IPC/Cmd/t/02_Interactive.t +++ b/lib/IPC/Cmd/t/02_Interactive.t @@ -1,110 +1,110 @@ -BEGIN { chdir 't' if -d 't' }; -BEGIN { use lib '../lib' }; - -use strict; -use File::Spec; - -### only run interactive tests when there's someone that can answer them -use Test::More -t STDOUT - ? 'no_plan' - : ( skip_all => "No interactive tests from harness" ); - -my $Class = 'IPC::Cmd'; -my $Child = File::Spec->catfile( qw[src child.pl] ); -my @FDs = 0..20; -my $IsWin32 = $^O eq 'MSWin32'; - -use_ok( $Class, 'run' ); -$IPC::Cmd::DEBUG = 1; - -my $Have_IPC_Run = $Class->can_use_ipc_run; -my $Have_IPC_Open3 = $Class->can_use_ipc_open3; - -### configurations to test IPC::Cmd with -my @Conf = ( - [ $Have_IPC_Run, $Have_IPC_Open3 ], - [ 0, $Have_IPC_Open3 ], - [ 0, 0 ] -); - - - - -### first, check which FD's are open. they should be open -### /after/ we run our tests as well. -### 0, 1 and 2 should be open, as they are STDOUT, STDERR and STDIN -### XXX 2 are opened by Test::Builder at least.. this is 'whitebox' -### knowledge, so unsafe to test against. around line 1322: -# sub _open_testhandles { -# return if $Opened_Testhandles; -# # We dup STDOUT and STDERR so people can change them in their -# # test suites while still getting normal test output. -# open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!"; -# open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!"; -# $Opened_Testhandles = 1; -# } - -my @Opened; -{ for ( @FDs ) { - my $fh; - my $rv = open $fh, "<&$_"; - push @Opened, $_ if $rv; - } - diag( "Opened FDs: @Opened" ); - cmp_ok( scalar(@Opened), '>=', 3, - "At least 3 FDs are opened" ); -} - -for my $aref ( @Conf ) { - - ### stupid warnings - local $IPC::Cmd::USE_IPC_RUN = $aref->[0]; - local $IPC::Cmd::USE_IPC_RUN = $aref->[0]; - - local $IPC::Cmd::USE_IPC_OPEN3 = $aref->[1]; - local $IPC::Cmd::USE_IPC_OPEN3 = $aref->[1]; - - diag("Config: IPC::Run = $aref->[0] IPC::Open3 = $aref->[1]"); - ok( -t STDIN, "STDIN attached to a tty" ); - - for my $cmd ( qq[$^X $Child], qq[$^X $Child | $^X -neprint] ) { - - diag("Please enter some input. It will be echo'd back to you"); - my $buffer; - my $ok = run( command => $cmd, verbose => 1, buffer => \$buffer ); - - ok( $ok, " Command '$cmd' ran succesfully" ); - - SKIP: { - skip "No buffers available", 1 unless $Class->can_capture_buffer; - ok( defined $buffer, " Input captured" ); - } - } -} - -### check we didnt leak any FHs -{ ### should be opened - my %open = map { $_ => 1 } @Opened; - - for ( @FDs ) { - my $fh; - my $rv = open $fh, "<&=$_"; - - ### these should be open - if( $open{$_} ) { - ok( $rv, "FD $_ opened" ); - ok( $fh, " FH indeed opened" ); - is( fileno($fh), $_, " Opened at the correct fileno($_)" ); - } else { - ok( !$rv, "FD $_ not opened" ); - ok( !(fileno($fh)), " FH indeed closed" ); - - ### extra debug info if tests fail -# use Devel::Peek; -# use Data::Dumper; -# diag( "RV=$rv FH=$fh Fileno=". fileno($fh). Dump($fh) ) if $rv; -# diag( Dumper( [stat $fh] ) ) if $rv; - - } - } -} +BEGIN { chdir 't' if -d 't' }; +BEGIN { use lib '../lib' }; + +use strict; +use File::Spec; + +### only run interactive tests when there's someone that can answer them +use Test::More -t STDOUT + ? 'no_plan' + : ( skip_all => "No interactive tests from harness" ); + +my $Class = 'IPC::Cmd'; +my $Child = File::Spec->catfile( qw[src child.pl] ); +my @FDs = 0..20; +my $IsWin32 = $^O eq 'MSWin32'; + +use_ok( $Class, 'run' ); +$IPC::Cmd::DEBUG = 1; + +my $Have_IPC_Run = $Class->can_use_ipc_run; +my $Have_IPC_Open3 = $Class->can_use_ipc_open3; + +### configurations to test IPC::Cmd with +my @Conf = ( + [ $Have_IPC_Run, $Have_IPC_Open3 ], + [ 0, $Have_IPC_Open3 ], + [ 0, 0 ] +); + + + + +### first, check which FD's are open. they should be open +### /after/ we run our tests as well. +### 0, 1 and 2 should be open, as they are STDOUT, STDERR and STDIN +### XXX 2 are opened by Test::Builder at least.. this is 'whitebox' +### knowledge, so unsafe to test against. around line 1322: +# sub _open_testhandles { +# return if $Opened_Testhandles; +# # We dup STDOUT and STDERR so people can change them in their +# # test suites while still getting normal test output. +# open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!"; +# open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!"; +# $Opened_Testhandles = 1; +# } + +my @Opened; +{ for ( @FDs ) { + my $fh; + my $rv = open $fh, "<&$_"; + push @Opened, $_ if $rv; + } + diag( "Opened FDs: @Opened" ); + cmp_ok( scalar(@Opened), '>=', 3, + "At least 3 FDs are opened" ); +} + +for my $aref ( @Conf ) { + + ### stupid warnings + local $IPC::Cmd::USE_IPC_RUN = $aref->[0]; + local $IPC::Cmd::USE_IPC_RUN = $aref->[0]; + + local $IPC::Cmd::USE_IPC_OPEN3 = $aref->[1]; + local $IPC::Cmd::USE_IPC_OPEN3 = $aref->[1]; + + diag("Config: IPC::Run = $aref->[0] IPC::Open3 = $aref->[1]"); + ok( -t STDIN, "STDIN attached to a tty" ); + + for my $cmd ( qq[$^X $Child], qq[$^X $Child | $^X -neprint] ) { + + diag("Please enter some input. It will be echo'd back to you"); + my $buffer; + my $ok = run( command => $cmd, verbose => 1, buffer => \$buffer ); + + ok( $ok, " Command '$cmd' ran succesfully" ); + + SKIP: { + skip "No buffers available", 1 unless $Class->can_capture_buffer; + ok( defined $buffer, " Input captured" ); + } + } +} + +### check we didnt leak any FHs +{ ### should be opened + my %open = map { $_ => 1 } @Opened; + + for ( @FDs ) { + my $fh; + my $rv = open $fh, "<&=$_"; + + ### these should be open + if( $open{$_} ) { + ok( $rv, "FD $_ opened" ); + ok( $fh, " FH indeed opened" ); + is( fileno($fh), $_, " Opened at the correct fileno($_)" ); + } else { + ok( !$rv, "FD $_ not opened" ); + ok( !(fileno($fh)), " FH indeed closed" ); + + ### extra debug info if tests fail +# use Devel::Peek; +# use Data::Dumper; +# diag( "RV=$rv FH=$fh Fileno=". fileno($fh). Dump($fh) ) if $rv; +# diag( Dumper( [stat $fh] ) ) if $rv; + + } + } +} diff --git a/lib/Log/Message.pm b/lib/Log/Message.pm index 6b61265..c5f2062 100644 --- a/lib/Log/Message.pm +++ b/lib/Log/Message.pm @@ -1,600 +1,600 @@ -package Log::Message; - -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.01; - - $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: +package Log::Message; + +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.01; + + $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: diff --git a/lib/Log/Message/Config.pm b/lib/Log/Message/Config.pm index eaeb78b..9769119 100644 --- a/lib/Log/Message/Config.pm +++ b/lib/Log/Message/Config.pm @@ -1,197 +1,197 @@ -package Log::Message::Config; -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.01; -} - -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") 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: +package Log::Message::Config; +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.01; +} + +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") 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: diff --git a/lib/Log/Message/Handlers.pm b/lib/Log/Message/Handlers.pm index d02fb52..c7c35c6 100644 --- a/lib/Log/Message/Handlers.pm +++ b/lib/Log/Message/Handlers.pm @@ -1,191 +1,191 @@ -package Log::Message::Handlers; -use strict; - -=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 -occurrent, 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: +package Log::Message::Handlers; +use strict; + +=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 +occurrent, 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: diff --git a/lib/Log/Message/Item.pm b/lib/Log/Message/Item.pm index 2ecf82d..85ae6fc 100644 --- a/lib/Log/Message/Item.pm +++ b/lib/Log/Message/Item.pm @@ -1,192 +1,192 @@ -package Log::Message::Item; - -use strict; -use Params::Check qw[check]; -use Log::Message::Handlers; - -### for the messages to store ### -use Carp (); - -BEGIN { - use vars qw[$AUTOLOAD $VERSION]; - - $VERSION = $Log::Message::VERSION; -} - -### 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 specificallly. - # 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: +package Log::Message::Item; + +use strict; +use Params::Check qw[check]; +use Log::Message::Handlers; + +### for the messages to store ### +use Carp (); + +BEGIN { + use vars qw[$AUTOLOAD $VERSION]; + + $VERSION = $Log::Message::VERSION; +} + +### 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 specificallly. + # 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: diff --git a/lib/Log/Message/t/conf/config_file b/lib/Log/Message/t/conf/config_file index 645cbb1..834529a 100644 --- a/lib/Log/Message/t/conf/config_file +++ b/lib/Log/Message/t/conf/config_file @@ -1,30 +1,30 @@ - # 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 = 0 \ No newline at end of file + # 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 = 0 diff --git a/lib/Module/Load/Conditional/t/to_load/Commented.pm b/lib/Module/Load/Conditional/t/to_load/Commented.pm index 1e3e057..2ee302e 100644 --- a/lib/Module/Load/Conditional/t/to_load/Commented.pm +++ b/lib/Module/Load/Conditional/t/to_load/Commented.pm @@ -1,4 +1,4 @@ -# $VERSION = 1; -$VERSION = 2; - -1; +# $VERSION = 1; +$VERSION = 2; + +1; diff --git a/lib/Module/Load/Conditional/t/to_load/LoadIt.pm b/lib/Module/Load/Conditional/t/to_load/LoadIt.pm index b97123d..87025e8 100644 --- a/lib/Module/Load/Conditional/t/to_load/LoadIt.pm +++ b/lib/Module/Load/Conditional/t/to_load/LoadIt.pm @@ -1,3 +1,3 @@ -$VERSION = 1; - -1; \ No newline at end of file +$VERSION = 1; + +1; diff --git a/lib/Module/Load/Conditional/t/to_load/Must/Be/Loaded.pm b/lib/Module/Load/Conditional/t/to_load/Must/Be/Loaded.pm index e1af010..e6423f3 100644 --- a/lib/Module/Load/Conditional/t/to_load/Must/Be/Loaded.pm +++ b/lib/Module/Load/Conditional/t/to_load/Must/Be/Loaded.pm @@ -1,3 +1,3 @@ -$VERSION = 0.01; - -1; \ No newline at end of file +$VERSION = 0.01; + +1; -- 2.7.4