File Coverage

blib/lib/Log/Any/Plugin/Levels.pm

Criterion	Covered	Total	%
statement	53	53	100.0
branch	14	14	100.0
condition	4	5	80.0
subroutine	12	12	100.0
pod	1	1	100.0
total	84	85	98.8

package Log::Any::Plugin::Levels;
# ABSTRACT: Logging-level filtering plugin for log adapters
$Log::Any::Plugin::Levels::VERSION = '0.007';
use strict;
use warnings;
use Carp qw(croak);
use Log::Any;

use Log::Any::Adapter::Util qw( numeric_level );
use Log::Any::Plugin::Util qw(
    all_logging_methods get_old_method set_new_method
);

my $default_level = 'warning';

# Inside-out storage for level field.
my %selected_level_name;

sub install {
    my ($class, $adapter_class, %args) = @_;

    my $accessor = $args{accessor} || 'level';
    croak $adapter_class . '::' . $accessor
        . q( already exists - use 'accessor' to specify another method name)
        if get_old_method($adapter_class, $accessor);

    if ($args{level}) {
        $default_level = $args{level};
        _get_level_value($default_level); # check
    }

    # Create the $log->level accessor
    set_new_method($adapter_class, $accessor, sub {
        my $self = shift;
        if (@_) {
            my $level_name = shift;
            _get_level_value($level_name); # check
            $selected_level_name{$self} = $level_name;
        }
        return $selected_level_name{$self};
    });

    # Augment the $log->debug methods
    for my $method_name ( all_logging_methods() ) {
        my $level = numeric_level($method_name);

        my $old_method = get_old_method($adapter_class, $method_name);
        set_new_method($adapter_class, $method_name, sub {
            my $self = shift;
            return if $level > _get_threshold_level($self);
            $self->$old_method(@_);
        });
    }

    # Augment the $log->is_debug methods
    for my $level_name ( all_logging_methods() ) {
        my $method_name = 'is_' . $level_name;
        my $level_value = numeric_level($level_name);

        my $old_method = get_old_method($adapter_class, $method_name);
        set_new_method($adapter_class, $method_name, sub {
            my $self = shift;
            return if $level_value > _get_threshold_level($self);
            return $self->$old_method(@_);
        });
    }
}

sub _get_level_value {
    my ($level_name) = @_;
    $level_name = $default_level if ($level_name eq 'default');
    my $level_value = numeric_level($level_name);
    croak('Unknown log level ' . $level_name)
        unless defined $level_value;
    return $level_value;
}

sub _get_threshold_level {
    my ($self) = @_;
    return _get_level_value($selected_level_name{$self} || $default_level);
}

1;

__END__