add support for is_*level* and is*Level*Enabled

Adapted from proposed patch at #1 Thanks to Matt/mindthemonkey for the contribution
polettix · Oct 13, 2012 · b52bbd4 · b52bbd4
1 parent a336740
commit b52bbd4
Show file tree

Hide file tree

Showing 2 changed files with 57 additions and 15 deletions.
diff --git a/lib/Log/Log4perl/Tiny.pm b/lib/Log/Log4perl/Tiny.pm
@@ -1,4 +1,5 @@
 package Log::Log4perl::Tiny;
+
 # ABSTRACT: mimic Log::Log4perl in one single module
 
 use warnings;
@@ -25,7 +26,7 @@ sub import {
    } ## end if (grep { $_ eq ':full_or_fake'...
 
    my (%done, $level_set);
-   ITEM:
+ ITEM:
    for my $item (@list) {
       next ITEM if $done{$item};
       $done{$item} = 1;
@@ -65,7 +66,7 @@ sub import {
                   $_instance->level($conf);
                }
             };
-         } ## end if (!Log::Log4perl->can...
+         } ## end if (!'Log::Log4perl'->can...
       } ## end elsif ($item =~ /\A : (mimic | mask | fake) \z/mxs)
       elsif ($item eq ':easy') {
          push @list, qw( :levels :subs :fake );
@@ -76,7 +77,7 @@ sub import {
       }
    } ## end for my $item (@list)
 
-   if (! $level_set) {
+   if (!$level_set) {
       my $logger = get_logger();
       $logger->_set_level_if_first($INFO);
       $logger->level($logger->level());
@@ -104,8 +105,8 @@ sub new {
    } ## end if (exists $args{file})
 
    my $self = bless {
-      fh     => \*STDERR,
-      level  => $INFO,
+      fh    => \*STDERR,
+      level => $INFO,
    }, $package;
 
    for my $accessor (qw( level fh format )) {
@@ -239,18 +240,18 @@ sub level {
       return unless exists $id_for{$level};
       $self->{level} = $id_for{$level};
       $self->{_count}++;
-   }
+   } ## end if (@_)
    return $self->{level};
-}
+} ## end sub level
 
 sub _set_level_if_first {
    my ($self, $level) = @_;
-   if (! $self->{_count}) {
+   if (!$self->{_count}) {
       $self->level($level);
       delete $self->{_count};
    }
    return;
-}
+} ## end sub _set_level_if_first
 
 BEGIN {
 
@@ -323,10 +324,19 @@ BEGIN {
    no strict 'refs';
 
    for my $name (qw( FATAL ERROR WARN INFO DEBUG TRACE )) {
+
+      # create the ->level methods
       *{__PACKAGE__ . '::' . lc($name)} = sub {
          my $self = shift;
          return $self->log($$name, @_);
       };
+
+      # create ->is_level and ->isLevelEnabled methods as well
+      *{__PACKAGE__ . '::is' . ucfirst(lc($name)) . 'Enabled'} =
+        *{__PACKAGE__ . '::is_' . lc($name)} = sub {
+         return 0 if $_[0]->{level} == $DEAD || $$name > $_[0]->{level};
+         return 1;
+        };
    } ## end for my $name (qw( FATAL ERROR WARN INFO DEBUG TRACE ))
 
    for my $name (
@@ -349,15 +359,15 @@ BEGIN {
          $self->{$accessor} = shift if @_;
          return $self->{$accessor};
       };
-   } ## end for my $accessor (qw( level fh logexit_code ))
+   } ## end for my $accessor (qw( fh logexit_code ))
 
    my $index = -1;
    for my $name (qw( DEAD OFF FATAL ERROR WARN INFO DEBUG TRACE )) {
       $name_of{$$name = $index} = $name;
-      $id_for{$name} = $index;
+      $id_for{$name}  = $index;
       $id_for{$index} = $index;
       ++$index;
-   }
+   } ## end for my $name (qw( DEAD OFF FATAL ERROR WARN INFO DEBUG TRACE ))
 
    get_logger();    # initialises $_instance;
 } ## end BEGIN
@@ -888,6 +898,32 @@ interface, but with lowercase method names:
 
 logging functions, each emits a log at the corresponding level;
 
+=item C<< is_trace >>
+
+=item C<< is_debug >>
+
+=item C<< is_info >>
+
+=item C<< is_warn >>
+
+=item C<< is_error >>
+
+=item C<< is_fatal >>
+
+=item C<< isTraceEnabled >>
+
+=item C<< isDebugEnabled >>
+
+=item C<< isInfoEnabled >>
+
+=item C<< isWarnEnabled >>
+
+=item C<< isErrorEnabled >>
+
+=item C<< isFatalEnabled >>
+
+log level test functions, each returns the status of the corresponding level;
+
 =item C<< always >>
 
 emit log whatever the configured logging level;

diff --git a/t/04.object.t b/t/04.object.t
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 37;    # last test to print
+use Test::More tests => 109;    # last test to print
 
 #use Test::More 'no_plan';
 use Log::Log4perl::Tiny qw( :levels );
@@ -23,15 +23,21 @@ for my $i (0 .. $#names) {
 
    my $blocked = 1;
    for my $name (@names) {
+      my $isfunc_perlish   = 'is_' . $name;
+      my $isfunc_javaesque = 'is' . ucfirst($name) . 'Enabled';
       $blocked = 0 if $name eq $current;
       if ($blocked) {
          log_is { $logger->$name("whatever $name") } '',
            "minimum level $current, nothing at $name level";
-      }
+         is($logger->$isfunc_perlish,   0, "is $name false");
+         is($logger->$isfunc_javaesque, 0, "is $name false (Java-esque)");
+      } ## end if ($blocked)
       else {
          log_like { $logger->$name("whatever $name") }
          qr/whatever\ $name/mxs,
            "minimum level $current, something at $name level";
-      }
+         is($logger->$isfunc_perlish,   1, "is $name true");
+         is($logger->$isfunc_javaesque, 1, "is $name true (Java-esque)");
+      } ## end else [ if ($blocked)
    } ## end for my $name (@names)
 } ## end for my $i (0 .. $#names)