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   6835 use 5.008001;
  13         49  
3 13     13   83 use strictures 2;
  13         98  
  13         477  
4             our $VERSION = '0.12';
5              
6             =head1 NAME
7              
8             Starch::Role::Log - Logging capabilities used internally by Starch.
9              
10             =cut
11              
12 13     13   2766 use Types::Standard -types;
  13         41  
  13         97  
13 13     13   64764 use Log::Any;
  13         99696  
  13         80  
14              
15 13     13   642 use Moo::Role;
  13         30  
  13         120  
16 13     13   5924 use namespace::clean;
  13         30  
  13         95  
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   541 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 533 my ($self) = @_;
56 162         326 my $class = ref( $self );
57 162         743 $class =~ s{__WITH__.*$}{};
58 162         594 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 269 my ($self) = @_;
70 90         229 my $class = $self->base_class_name();
71 90         281 $class =~ s{^Starch::}{};
72 90         292 return $class;
73             }
74              
75             1;
76             __END__