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