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