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;