view lib/IMPL/Debug.pm @ 427:09e0086a82a7 ref20150831 tip

Merge
author cin
date Tue, 15 May 2018 00:51:33 +0300
parents b0481c071bea
children
line wrap: on
line source

package IMPL::Debug;
use strict;
use warnings;

our $ENABLE = 0;
our %ENABLE;

my %subscriptions;
my @subscriptions;

sub stub { }

sub import {
    my ( $self, @args ) = @_;

    my $caller = caller;
    no strict 'refs';

    my $enabled = exists $ENABLE{$caller} ? $ENABLE{$caller} : $ENABLE;

    *{"${caller}::dbg_log"} = $enabled
      ? sub {
        $self->log( $caller, @_ );
      }
      : \&stub;

    *{"${caller}::dbg_error"} = $enabled
      ? sub {
        $self->log( $caller, @_ );
      }
      : \&stub;

    *{"${caller}::dbg_warn"} = $enabled
      ? sub {
        $self->log( $caller, @_ );
      }
      : \&stub;
}

sub log {
    my $self    = shift;
    my $channel = shift;
    $_->(@_) foreach @{ $subscriptions{$channel} || [] };
    $_->(@_) foreach @subscriptions;
}

sub subscribe {
    my ( $self, $channel, $callback ) = @_;

    if ( @_ == 2 ) {
        $callback = $channel;
        $channel  = undef;
    }

    die IMPL::InvalidArgumentException->new('callback')
      unless ref $callback eq 'CODE';

    if ($channel) {
        push @{ $subscriptions{$channel} }, $callback;
    }
    else {
        push @subscriptions, $callback;
    }
}

1;