File Coverage

blib/lib/Log/Contextual/SimpleLogger.pm

Criterion	Covered	Total	%
statement	33	33	100.0
branch	7	8	87.5
condition	2	3	66.6
subroutine	8	8	100.0
pod	1	1	100.0
total	51	53	96.2

package Log::Contextual::SimpleLogger;
use strict;
use warnings;

our $VERSION = '0.009001';

{
  for my $name (qw( trace debug info warn error fatal )) {

    no strict 'refs';

    *{$name} = sub {
      my $self = shift;

      $self->_log($name, @_)
        if ($self->{$name});
    };

    *{"is_$name"} = sub {
      my $self = shift;
      return $self->{$name};
    };
  }
}

sub new {
  my ($class, $args) = @_;
  my $self = bless {}, $class;

  $self->{$_} = 1 for @{$args->{levels}};
  $self->{coderef} = $args->{coderef} || sub { print STDERR @_ };

  if (my $upto = $args->{levels_upto}) {

    my @levels = (qw( trace debug info warn error fatal ));
    my $i      = 0;
    for (@levels) {
      last if $upto eq $_;
      $i++
    }
    for ($i .. $#levels) {
      $self->{$levels[$_]} = 1
    }

  }
  return $self;
}

sub _log {
  my $self    = shift;
  my $level   = shift;
  my $message = join("\n", @_);
  $message .= "\n" unless $message =~ /\n$/;
  $self->{coderef}->(sprintf("[%s] %s", $level, $message));
}

1;

__END__