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 66     66   36902 use Moo::Role;
  66         186  
  66         477  
3 66     66   24405 use Sub::Quote qw(quote_sub);
  66         190  
  66         6993  
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 123     123   3266 my ($self) = @_;
16 123         335 my $class = ref $self;
17 66     66   554 no strict 'refs';
  66         207  
  66         6987  
18 123         224 return ${"${class}::DEBUG"};
  123         2479  
19             }
20              
21             around debugging => sub {
22             my ($orig, $self) = (shift, shift);
23              
24             # Emulate horrible Class::Base API
25             unless (ref $self) {
26 66     66   564 my $dbgref = do { no strict 'refs'; \${"${self}::DEBUG"} };
  66         264  
  66         11621  
27             $$dbgref = $_[0] if @_;
28             return $$dbgref;
29             }
30             return $self->$orig(@_);
31             };
32              
33             sub debug {
34 767     767 0 1431 my $self = shift;
35              
36 767 50       15990 return unless $self->debugging;
37              
38 0   0       print STDERR '[', (ref $self || $self), '] ', @_, "\n";
39             }
40              
41             1;