Commit | Line | Data |
6419f0f3 |
1 | package SQL::Translator::Role::Debug; |
2 | use Moo::Role; |
3 | |
4 | has _DEBUG => ( |
5 | is => 'rw', |
6 | accessor => 'debugging', |
7 | init_arg => 'debugging', |
8 | coerce => sub { $_[0] ? 1 : 0 }, |
9 | lazy => 1, |
10 | builder => 1, |
11 | ); |
12 | |
13 | sub _build__DEBUG { |
14 | my ($self) = @_; |
15 | my $class = ref $self; |
16 | no strict 'refs'; |
17 | return ${"${class}::DEBUG"}; |
18 | } |
19 | |
20 | around debugging => sub { |
21 | my ($orig, $self) = (shift, shift); |
22 | |
23 | # Emulate horrible Class::Base API |
24 | unless (ref $self) { |
25 | my $dbgref = do { no strict 'refs'; \${"${self}::DEBUG"} }; |
26 | $$dbgref = $_[0] if @_; |
27 | return $$dbgref; |
28 | } |
29 | return $self->$orig(@_); |
30 | }; |
31 | |
32 | sub debug { |
33 | my $self = shift; |
34 | |
35 | return unless $self->debugging; |
36 | |
37 | print STDERR '[', (ref $self || $self), '] ', @_, "\n"; |
38 | } |
39 | |
40 | 1; |