lib/SQL/Translator/Role/Debug.pm

   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;