release 0.11016
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Role / Debug.pm
1 package SQL::Translator::Role::Debug;
2 use Moo::Role;
3 use Sub::Quote qw(quote_sub);
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     my ($self) = @_;
16     my $class = ref $self;
17     no strict 'refs';
18     return ${"${class}::DEBUG"};
19 }
20
21 around 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
33 sub debug {
34     my $self = shift;
35
36     return unless $self->debugging;
37
38     print STDERR '[', (ref $self || $self), '] ', @_, "\n";
39 }
40
41 1;