File Coverage

blib/lib/SQL/Translator/Role/Debug.pm
Criterion Covered Total %
statement 18 19 94.7
branch 1 2 50.0
condition 0 3 0.0
subroutine 6 6 100.0
pod 0 1 0.0
total 25 31 80.6


line stmt bran cond sub pod time code
1             package SQL::Translator::Role::Debug;
2 68     68   34128 use Moo::Role;
  68         154  
  68         440  
3 68     68   21829 use Sub::Quote qw(quote_sub);
  68         139  
  68         6344  
4              
5             has _DEBUG => (
6             is => 'rw',
7             accessor => 'debugging',
8             init_arg => 'debugging',
9             coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
10             lazy => 1,
11             builder => 1,
12             );
13              
14             sub _build__DEBUG {
15 135     135   2566 my ($self) = @_;
16 135         329 my $class = ref $self;
17 68     68   442 no strict 'refs';
  68         138  
  68         6001  
18 135         256 return ${"${class}::DEBUG"};
  135         2254  
19             }
20              
21             around debugging => sub {
22             my ($orig, $self) = (shift, shift);
23              
24             # Emulate horrible Class::Base API
25             unless (ref $self) {
26 68     68   455 my $dbgref = do { no strict 'refs'; \${"${self}::DEBUG"} };
  68         160  
  68         10475  
27             $$dbgref = $_[0] if @_;
28             return $$dbgref;
29             }
30             return $self->$orig(@_);
31             };
32              
33             sub debug {
34 923     923 0 1525 my $self = shift;
35              
36 923 50       15961 return unless $self->debugging;
37              
38 0   0       print STDERR '[', (ref $self || $self), '] ', @_, "\n";
39             }
40              
41             1;