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 32     32   221365 use 5.008001;
  32         100  
2 32     32   146 use strict;
  32         48  
  32         760  
3 32     32   131 use warnings;
  32         54  
  32         2967  
4              
5             package Log::Any::Adapter::Base;
6              
7             our $VERSION = '1.718';
8             our @CARP_NOT = ( 'Log::Any::Adapter' );
9              
10             # we import these in case any legacy adapter uses them as class methods
11 32     32   1311 use Log::Any::Adapter::Util qw/make_method dump_one_line/;
  32         70  
  32         4578  
12              
13             sub new {
14 131     131 0 248 my $class = shift;
15 131         352 my $self = {@_};
16 131         219 bless $self, $class;
17 131         420 $self->init(@_);
18 127         778 return $self;
19             }
20              
21       78 0   sub init { }
22              
23             # Create stub logging methods
24             for my $method ( Log::Any::Adapter::Util::logging_and_detection_methods() ) {
25 32     32   172 no strict 'refs';
  32         45  
  32         6694  
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__