initial WarnLogger stuff

diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm
index d129cdb..78ffcb3 100644 (file)
--- 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<set_logger> 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 (file)
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<Log::Contextual>.  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<Log::Contextual/set_logger> to override
+your choice of logger in their own code thanks to the way L<Log::Contextual>
+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<env_prefix> defines what the prefix is for
+the environment variables that will be checked for the six log levels.  For
+example, if C<env_prefix> is set to C<FREWS_PACKAGE> 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<Log::Contextual/"AUTHOR">
+
+=head1 COPYRIGHT
+
+See L<Log::Contextual/"COPYRIGHT">
+
+=head1 LICENSE
+
+See L<Log::Contextual/"LICENSE">
+
+=cut
+

diff --git a/t/warnlogger.t b/t/warnlogger.t
new file mode 100644 (file)
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');
+
+}