From: Arthur Axel 'fREW' Schmidt Date: Wed, 3 Mar 2010 04:47:16 +0000 (-0600) Subject: initial WarnLogger stuff X-Git-Tag: v0.00200~4 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ae59bbe3eb3621a08a74d421be1dc81b725d45f8;p=p5sagit%2FLog-Contextual.git initial WarnLogger stuff --- diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm index d129cdb..78ffcb3 100644 --- a/lib/Log/Contextual.pm +++ b/lib/Log/Contextual.pm @@ -1,7 +1,4 @@ # add example for Log::Dispatchouli -# -# make basic warn logger - package Log::Contextual; @@ -409,7 +406,7 @@ Basically it sets the logger to be used if C is never called; so use Log::Contextual::SimpleLogger; use Log::Contextual qw( :log ), -default_logger => Log::Contextual::WarnLogger->new({ - env_var => 'MY_PACKAGE' + env_prefix => 'MY_PACKAGE' }); If you are interested in using this package for a module you are putting on diff --git a/lib/Log/Contextual/WarnLogger.pm b/lib/Log/Contextual/WarnLogger.pm new file mode 100644 index 0000000..2dd8eb2 --- /dev/null +++ b/lib/Log/Contextual/WarnLogger.pm @@ -0,0 +1,177 @@ +package Log::Contextual::WarnLogger; + +use strict; +use warnings; + +{ + for my $name (qw( trace debug info warn error fatal )) { + + no strict 'refs'; + + my $is_name = "is_$name"; + *{$name} = sub { + my $self = shift; + + $self->_log( $name, @_ ) + if $self->$is_name; + }; + + *{$is_name} = sub { + my $self = shift; + return $ENV{$self->{env_prefix} . '_' . uc $name}; + }; + } +} + +sub new { + my ($class, $args) = @_; + my $self = bless {}, $class; + + $self->{env_prefix} = $args->{env_prefix} or + die 'no env_prefix passed to Log::Contextual::WarnLogger->new'; + return $self; +} + +sub _log { + my $self = shift; + my $level = shift; + my $message = join( "\n", @_ ); + $message .= "\n" unless $message =~ /\n$/; + warn "[$level] $message"; +} + +1; + +__END__ + +=head1 NAME + +Log::Contextual::WarnLogger - Simple logger for libraries using Log::Contextual + +=head1 SYNOPSIS + + package My::Package; + use Log::Contextual::WarnLogger; + use Log::Contextual qw( :log ), + -default_logger => Log::Contextual::WarnLogger->new({ + env_prefix => 'MY_PACKAGE' + }); + + # warns '[info] program started' if $ENV{MY_PACKAGE_TRACE} is set + log_info { 'program started' }; # no-op because info is not in levels + sub foo { + # warns '[debug] entered foo' if $ENV{MY_PACKAGE_DEBUG} is set + log_debug { 'entered foo' }; + ... + } + +=head1 DESCRIPTION + +This module is a simple logger made for libraries using L. We +recommend the use of this logger as your default logger as it is simple and +useful for most users, yet users can use L to override +your choice of logger in their own code thanks to the way L +works. + +=head1 METHODS + +=head2 new + +Arguments: C<< Dict[ env_prefix => Str ] $conf >> + + my $l = Log::Contextual::WarnLogger->new({ + env_prefix + }); + +Creates a new logger object where C defines what the prefix is for +the environment variables that will be checked for the six log levels. For +example, if C is set to C the following environment +variables will be used: + + FREWS_PACKAGE_TRACE + FREWS_PACKAGE_DEBUG + FREWS_PACKAGE_INFO + FREWS_PACKAGE_WARN + FREWS_PACKAGE_ERROR + FREWS_PACKAGE_FATAL + +=head2 $level + +Arguments: C<@anything> + +All of the following six methods work the same. The basic pattern is: + + sub $level { + my $self = shift; + + warn "[$level] " . join qq{\n}, @_; + if $self->is_$level; + } + +=head3 trace + + $l->trace( 'entered method foo with args ' join q{,}, @args ); + +=head3 debug + + $l->debug( 'entered method foo' ); + +=head3 info + + $l->info( 'started process foo' ); + +=head3 warn + + $l->warn( 'possible misconfiguration at line 10' ); + +=head3 error + + $l->error( 'non-numeric user input!' ); + +=head3 fatal + + $l->fatal( '1 is never equal to 0!' ); + +=head2 is_$level + +All of the following six functions just return true if their respective +environment variable is enabled. + +=head3 is_trace + + say 'tracing' if $l->is_trace; + +=head3 is_debug + + say 'debuging' if $l->is_debug; + +=head3 is_info + + say q{info'ing} if $l->is_info; + +=head3 is_warn + + say 'warning' if $l->is_warn; + +=head3 is_error + + say 'erroring' if $l->is_error; + +=head3 is_fatal + + say q{fatal'ing} if $l->is_fatal; + +=head1 AUTHOR + +See L + +=head1 COPYRIGHT + +See L + +=head1 LICENSE + +See L + +=cut + diff --git a/t/warnlogger.t b/t/warnlogger.t new file mode 100644 index 0000000..a0c3726 --- /dev/null +++ b/t/warnlogger.t @@ -0,0 +1,65 @@ +use strict; +use warnings; + +use Log::Contextual::WarnLogger; +use Log::Contextual qw{:log set_logger} => -logger => + Log::Contextual::WarnLogger->new({ env_prefix => 'FOO' }); +use Test::More qw(no_plan); +my $l = Log::Contextual::WarnLogger->new({ env_prefix => 'BAR' }); + +{ + local $ENV{BAR_TRACE} = 0; + local $ENV{BAR_DEBUG} = 1; + local $ENV{BAR_INFO} = 0; + local $ENV{BAR_WARN} = 0; + local $ENV{BAR_ERROR} = 0; + local $ENV{BAR_FATAL} = 0; + ok(!$l->is_trace, 'is_trace is false on WarnLogger'); + ok($l->is_debug, 'is_debug is true on WarnLogger'); + ok(!$l->is_info, 'is_info is false on WarnLogger'); + ok(!$l->is_warn, 'is_warn is false on WarnLogger'); + ok(!$l->is_error, 'is_error is false on WarnLogger'); + ok(!$l->is_fatal, 'is_fatal is false on WarnLogger'); +} + +{ + local $ENV{FOO_TRACE} = 0; + local $ENV{FOO_DEBUG} = 1; + local $ENV{FOO_INFO} = 0; + local $ENV{FOO_WARN} = 0; + local $ENV{FOO_ERROR} = 0; + local $ENV{FOO_FATAL} = 0; + ok(eval { log_trace { die 'this should live' }; 1}, 'trace does not get called'); + ok(!eval { log_debug { die 'this should die' }; 1}, 'debug gets called'); + ok(eval { log_info { die 'this should live' }; 1}, 'info does not get called'); + ok(eval { log_warn { die 'this should live' }; 1}, 'warn does not get called'); + ok(eval { log_error { die 'this should live' }; 1}, 'error does not get called'); + ok(eval { log_fatal { die 'this should live' }; 1}, 'fatal does not get called'); +} + +{ + local $ENV{FOO_TRACE} = 1; + local $ENV{FOO_DEBUG} = 1; + local $ENV{FOO_INFO} = 1; + local $ENV{FOO_WARN} = 1; + local $ENV{FOO_ERROR} = 1; + local $ENV{FOO_FATAL} = 1; + my $cap; + local $SIG{__WARN__} = sub { $cap = shift }; + + log_debug { 'frew' }; + is($cap, "[debug] frew\n", 'WarnLogger outputs to STDERR correctly'); + log_trace { 'trace' }; + is($cap, "[trace] trace\n", 'trace renders correctly'); + log_debug { 'debug' }; + is($cap, "[debug] debug\n", 'debug renders correctly'); + log_info { 'info' }; + is($cap, "[info] info\n", 'info renders correctly'); + log_warn { 'warn' }; + is($cap, "[warn] warn\n", 'warn renders correctly'); + log_error { 'error' }; + is($cap, "[error] error\n", 'error renders correctly'); + log_fatal { 'fatal' }; + is($cap, "[fatal] fatal\n", 'fatal renders correctly'); + +}