File Coverage

blib/lib/Starch/Role/Log.pm
Criterion Covered Total %
statement 27 27 100.0
branch n/a
condition n/a
subroutine 9 9 100.0
pod 2 2 100.0
total 38 38 100.0


line stmt bran cond sub pod time code
1             package Starch::Role::Log;
2 13     13   7085 use 5.008001;
  13         47  
3 13     13   73 use strictures 2;
  13         134  
  13         495  
4             our $VERSION = '0.11';
5              
6             =head1 NAME
7              
8             Starch::Role::Log - Logging capabilities used internally by Starch.
9              
10             =cut
11              
12 13     13   2755 use Types::Standard -types;
  13         31  
  13         96  
13 13     13   63866 use Log::Any;
  13         97847  
  13         106  
14              
15 13     13   605 use Moo::Role;
  13         32  
  13         112  
16 13     13   6273 use namespace::clean;
  13         31  
  13         89  
17              
18             =head1 ATTRIBUTES
19              
20             =head2 log
21              
22             Returns a L object used for logging to L.
23             The category is set to the object's package name, minus any
24             C<__WITH__.*> bits that Moo::Role adds when composing a class
25             from roles.
26              
27             No logging is produced by the stock L. The
28             L plugin adds extensive logging.
29              
30             More info about logging can be found at
31             L.
32              
33             =cut
34              
35             has log => (
36             is => 'lazy',
37             init_arg => undef,
38             );
39             sub _build_log {
40 64     64   538 my ($self) = @_;
41              
42 64         141 return Log::Any->get_logger(
43             category => $self->base_class_name(),
44             );
45             }
46              
47             =head2 base_class_name
48              
49             Returns the object's class name minus the C<__WITH__.*> suffix put on
50             by plugins. This is used to produce more concise logging output.
51              
52             =cut
53              
54             sub base_class_name {
55 162     162 1 366 my ($self) = @_;
56 162         314 my $class = ref( $self );
57 162         756 $class =~ s{__WITH__.*$}{};
58 162         578 return $class;
59             }
60              
61             =head2 short_class_name
62              
63             Returns L with the C prefix
64             removed.
65              
66             =cut
67              
68             sub short_class_name {
69 90     90 1 270 my ($self) = @_;
70 90         222 my $class = $self->base_class_name();
71 90         282 $class =~ s{^Starch::}{};
72 90         280 return $class;
73             }
74              
75             1;
76             __END__