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   40667 use Moo::Role;
  68         187  
  68         526  
3 68     68   26062 use Sub::Quote qw(quote_sub);
  68         174  
  68         7625  
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 134     134   3091 my ($self) = @_;
16 134         371 my $class = ref $self;
17 68     68   579 no strict 'refs';
  68         182  
  68         7162  
18 134         275 return ${"${class}::DEBUG"};
  134         2736  
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   544 my $dbgref = do { no strict 'refs'; \${"${self}::DEBUG"} };
  68         193  
  68         11930  
27             $$dbgref = $_[0] if @_;
28             return $$dbgref;
29             }
30             return $self->$orig(@_);
31             };
32              
33             sub debug {
34 912     912 0 1784 my $self = shift;
35              
36 912 50       19147 return unless $self->debugging;
37              
38 0   0       print STDERR '[', (ref $self || $self), '] ', @_, "\n";
39             }
40              
41             1;