File Coverage

blib/lib/Log/Any/Adapter/Base.pm
Criterion Covered Total %
statement 19 25 76.0
branch n/a
condition 0 3 0.0
subroutine 7 10 70.0
pod 0 3 0.0
total 26 41 63.4


line stmt bran cond sub pod time code
1 23     23   72301 use 5.008001;
  23         84  
2 23     23   125 use strict;
  23         43  
  23         520  
3 23     23   114 use warnings;
  23         39  
  23         1749  
4              
5             package Log::Any::Adapter::Base;
6              
7             our $VERSION = '1.715';
8             our @CARP_NOT = ( 'Log::Any::Adapter' );
9              
10             # we import these in case any legacy adapter uses them as class methods
11 23     23   597 use Log::Any::Adapter::Util qw/make_method dump_one_line/;
  23         51  
  23         3187  
12              
13             sub new {
14 127     127 0 242 my $class = shift;
15 127         328 my $self = {@_};
16 127         256 bless $self, $class;
17 127         411 $self->init(@_);
18 123         720 return $self;
19             }
20              
21       75 0   sub init { }
22              
23             # Create stub logging methods
24             for my $method ( Log::Any::Adapter::Util::logging_and_detection_methods() ) {
25 23     23   189 no strict 'refs';
  23         42  
  23         4275  
26             *$method = sub {
27 0   0 0     my $class = ref( $_[0] ) || $_[0];
28 0           die "$class does not implement $method";
29             };
30             }
31              
32             # This methods installs a method that delegates to an object attribute
33             sub delegate_method_to_slot {
34 0     0 0   my ( $class, $slot, $method, $adapter_method ) = @_;
35              
36             make_method( $method,
37 0     0     sub { my $self = shift; return $self->{$slot}->$adapter_method(@_) },
  0            
38 0           $class );
39             }
40              
41             1;
42              
43             __END__