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


line stmt bran cond sub pod time code
1             package Log::Any::Plugin::Levels;
2             # ABSTRACT: Logging-level filtering plugin for log adapters
3             $Log::Any::Plugin::Levels::VERSION = '0.011';
4 1     1   721 use strict;
  1         2  
  1         27  
5 1     1   4 use warnings;
  1         1  
  1         27  
6 1     1   4 use Carp qw(croak);
  1         1  
  1         54  
7 1     1   5 use Log::Any;
  1         2  
  1         5  
8              
9 1     1   69 use Log::Any::Adapter::Util qw( numeric_level );
  1         2  
  1         51  
10 1         443 use Log::Any::Plugin::Util qw(
11             all_logging_methods get_old_method set_new_method
12 1     1   5 );
  1         2  
13              
14             my $default_level = 'warning';
15              
16             # Inside-out storage for level field.
17             my %selected_level_name;
18              
19             sub install {
20 3     3 1 9 my ($class, $adapter_class, %args) = @_;
21              
22 3   100     11 my $accessor = $args{accessor} || 'level';
23 3 100       9 croak $adapter_class . '::' . $accessor
24             . q( already exists - use 'accessor' to specify another method name)
25             if get_old_method($adapter_class, $accessor);
26              
27 2 100       6 if ($args{level}) {
28 1         3 $default_level = $args{level};
29 1         3 _get_level_value($default_level); # check
30             }
31              
32             # Create the $log->level accessor
33             set_new_method($adapter_class, $accessor, sub {
34 5     5   2530 my $self = shift;
35 5 100       12 if (@_) {
36 3         5 my $level_name = shift;
37 3         7 _get_level_value($level_name); # check
38 2         5 $selected_level_name{$self} = $level_name;
39             }
40 4         18 return $selected_level_name{$self};
41 2         13 });
42              
43             # Augment the $log->debug methods
44 2         6 for my $method_name ( all_logging_methods() ) {
45 38         73 my $level = numeric_level($method_name);
46              
47 38         204 my $old_method = get_old_method($adapter_class, $method_name);
48             set_new_method($adapter_class, $method_name, sub {
49 7     7   511 my $self = shift;
50 7 100       17 return if $level > _get_threshold_level($self);
51 3         9 $self->$old_method(@_);
52 38         127 });
53             }
54              
55             # Augment the $log->is_debug methods
56 2         5 for my $level_name ( all_logging_methods() ) {
57 38         67 my $method_name = 'is_' . $level_name;
58 38         55 my $level_value = numeric_level($level_name);
59              
60 38         205 my $old_method = get_old_method($adapter_class, $method_name);
61             set_new_method($adapter_class, $method_name, sub {
62 7     7   1622 my $self = shift;
63 7 100       15 return if $level_value > _get_threshold_level($self);
64 3         9 return $self->$old_method(@_);
65 38         172 });
66             }
67             }
68              
69             sub _get_level_value {
70 18     18   23 my ($level_name) = @_;
71 18 100       31 $level_name = $default_level if ($level_name eq 'default');
72 18         45 my $level_value = numeric_level($level_name);
73 18 100       129 croak('Unknown log level ' . $level_name)
74             unless defined $level_value;
75 17         45 return $level_value;
76             }
77              
78             sub _get_threshold_level {
79 14     14   16 my ($self) = @_;
80 14   66     78 return _get_level_value($selected_level_name{$self} || $default_level);
81             }
82              
83             1;
84              
85             __END__