Skip to content

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
...
  • 2 commits
  • 3 files changed
  • 0 commit comments
  • 2 contributors
Commits on Oct 13, 2012
Matt add support for is_*level* and is*Level*Enabled
Adapted from proposed patch at
#1

Thanks to Matt/mindthemonkey for the contribution
b52bbd4
@polettix updated Changes d9436d0
Showing with 60 additions and 15 deletions.
  1. +3 −0 Changes
  2. +48 −12 lib/Log/Log4perl/Tiny.pm
  3. +9 −3 t/04.object.t
View
3 Changes
@@ -1,4 +1,7 @@
{{$NEXT}}
+ - added support for is_<<level>> and is<<Level>>Enabled by
+ mindthemonkey on GitHub
+ (https://github.com/polettix/Log-Log4perl-Tiny/pull/1)
1.1.2 2011-12-28 10:19:59 Europe/Rome
- reverting to previous release numbering scheme... hopefully
View
60 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;
View
12 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)

No commit comments for this range

Something went wrong with that request. Please try again.