File Coverage

blib/lib/Starch/Role/Log.pm
Criterion Covered Total %
statement 25 25 100.0
branch n/a
condition n/a
subroutine 8 8 100.0
pod 2 2 100.0
total 35 35 100.0


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