File Coverage

blib/lib/Log/Any/Adapter/Callback.pm
Criterion Covered Total %
statement 12 30 40.0
branch 0 18 0.0
condition 0 3 0.0
subroutine 4 9 44.4
pod 0 1 0.0
total 16 61 26.2


line stmt bran cond sub pod time code
1             package Log::Any::Adapter::Callback;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2020-01-14'; # DATE
5             our $DIST = 'Log-Any-Adapter-Callback'; # DIST
6             our $VERSION = '0.100'; # VERSION
7              
8 1     1   52860 use strict;
  1         8  
  1         24  
9 1     1   4 use warnings;
  1         2  
  1         23  
10              
11 1     1   369 use Log::Any::Adapter::Util qw(make_method);
  1         8140  
  1         40  
12 1     1   5 use base qw(Log::Any::Adapter::Base);
  1         2  
  1         358  
13              
14             my @logging_methods = Log::Any->logging_methods;
15             my %logging_levels;
16             for my $i (0..@logging_methods-1) {
17             $logging_levels{$logging_methods[$i]} = $i;
18             }
19              
20             sub _default_level {
21             return $ENV{LOG_LEVEL}
22 0 0 0 0     if $ENV{LOG_LEVEL} && $logging_levels{$ENV{LOG_LEVEL}};
23 0 0         return 'trace' if $ENV{TRACE};
24 0 0         return 'debug' if $ENV{DEBUG};
25 0 0         return 'info' if $ENV{VERBOSE};
26 0 0         return 'error' if $ENV{QUIET};
27 0           'warning';
28             }
29              
30             my ($logging_cb, $detection_cb);
31             sub init {
32 0     0 0   my ($self) = @_;
33             $logging_cb = $self->{logging_cb}
34 0 0         or die "Please provide logging_cb when initializing ".__PACKAGE__;
35 0 0         if ($self->{detection_cb}) {
36 0           $detection_cb = $self->{detection_cb};
37             } else {
38 0     0     $detection_cb = sub { 1 };
  0            
39             }
40 0 0         if (!defined($self->{min_level})) { $self->{min_level} = _default_level() }
  0            
41             }
42              
43             for my $method (Log::Any->logging_methods()) {
44             make_method(
45             $method,
46             sub {
47 0     0     my $self = shift;
48             return if $logging_levels{$method} <
49 0 0         $logging_levels{ $self->{min_level} };
50 0           $logging_cb->($method, $self, @_);
51             });
52             }
53              
54             for my $method (Log::Any->detection_methods()) {
55             make_method(
56             $method,
57             sub {
58 0     0     $detection_cb->($method, @_);
59             });
60             }
61              
62             1;
63             # ABSTRACT: Send Log::Any logs to a subroutine
64              
65             __END__