Add warnlogger UPTO env var

diff --git a/Changes b/Changes
index fb3040c..f32e4b9 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 ChangeLog for Log-Contextual
 
+0.00304 2010-07-31
+  - Add $package_UPTO environment variable for WarnLogger
+
 0.00303 2010-07-10
   - Fix broken Log::Log4perl test
 

diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm
index 3585c76..7520290 100644 (file)
--- a/lib/Log/Contextual.pm
+++ b/lib/Log/Contextual.pm
@@ -3,7 +3,7 @@ package Log::Contextual;
 use strict;
 use warnings;
 
-our $VERSION = '0.00303';
+our $VERSION = '0.00304';
 
 require Exporter;
 use Data::Dumper::Concise;

diff --git a/lib/Log/Contextual/WarnLogger.pm b/lib/Log/Contextual/WarnLogger.pm
index 2dd8eb2..7f37390 100644 (file)
--- a/lib/Log/Contextual/WarnLogger.pm
+++ b/lib/Log/Contextual/WarnLogger.pm
@@ -4,7 +4,9 @@ use strict;
 use warnings;
 
 {
-  for my $name (qw( trace debug info warn error fatal )) {
+  my @levels = (qw( trace debug info warn error fatal ));
+  my %level_num; @level_num{ @levels } = (0 .. $#levels);
+  for my $name (@levels) {
 
     no strict 'refs';
 
@@ -18,7 +20,12 @@ use warnings;
 
     *{$is_name} = sub {
       my $self = shift;
-      return $ENV{$self->{env_prefix} . '_' . uc $name};
+      return 1 if $ENV{$self->{env_prefix} . '_' . uc $name};
+      my $upto = $ENV{$self->{env_prefix} . '_UPTO'};
+      return unless $upto;
+      $upto = lc $upto;
+
+      return $level_num{$name} >= $level_num{$upto};
     };
   }
 }
@@ -88,6 +95,8 @@ 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_UPTO
+
  FREWS_PACKAGE_TRACE
  FREWS_PACKAGE_DEBUG
  FREWS_PACKAGE_INFO
@@ -95,6 +104,10 @@ variables will be used:
  FREWS_PACKAGE_ERROR
  FREWS_PACKAGE_FATAL
 
+Note that C<UPTO> is a convenience variable.  If you set
+C<< FOO_UPTO=TRACE >> it will enable all log levels.  Similarly, if you
+set it to C<FATAL> only fatal will be enabled.
+
 =head2 $level
 
 Arguments: C<@anything>

diff --git a/t/warnlogger.t b/t/warnlogger.t
index a0c3726..1a07292 100644 (file)
--- a/t/warnlogger.t
+++ b/t/warnlogger.t
@@ -23,6 +23,28 @@ my $l = Log::Contextual::WarnLogger->new({ env_prefix => 'BAR' });
 }
 
 {
+   local $ENV{BAR_UPTO} = 'TRACE';
+
+   ok($l->is_trace, 'is_trace is true on WarnLogger');
+   ok($l->is_debug, 'is_debug is true on WarnLogger');
+   ok($l->is_info, 'is_info is true on WarnLogger');
+   ok($l->is_warn, 'is_warn is true on WarnLogger');
+   ok($l->is_error, 'is_error is true on WarnLogger');
+   ok($l->is_fatal, 'is_fatal is true on WarnLogger');
+}
+
+{
+   local $ENV{BAR_UPTO} = 'warn';
+
+   ok(!$l->is_trace, 'is_trace is false on WarnLogger');
+   ok(!$l->is_debug, 'is_debug is false on WarnLogger');
+   ok(!$l->is_info, 'is_info is false on WarnLogger');
+   ok($l->is_warn, 'is_warn is true on WarnLogger');
+   ok($l->is_error, 'is_error is true on WarnLogger');
+   ok($l->is_fatal, 'is_fatal is true on WarnLogger');
+}
+
+{
    local $ENV{FOO_TRACE} = 0;
    local $ENV{FOO_DEBUG} = 1;
    local $ENV{FOO_INFO} = 0;