| 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; |