comparison lib/IMPL/Debug.pm @ 422:b0481c071bea ref20150831

IMPL::Config::Container tests, YAMLConfiguration now works and tested
author cin
date Sun, 20 Aug 2017 00:20:41 +0300
parents
children
comparison
equal deleted inserted replaced
421:7798345304bc 422:b0481c071bea
1 package IMPL::Debug;
2 use strict;
3 use warnings;
4
5 our $ENABLE = 0;
6 our %ENABLE;
7
8 my %subscriptions;
9 my @subscriptions;
10
11 sub stub { }
12
13 sub import {
14 my ( $self, @args ) = @_;
15
16 my $caller = caller;
17 no strict 'refs';
18
19 my $enabled = exists $ENABLE{$caller} ? $ENABLE{$caller} : $ENABLE;
20
21 *{"${caller}::dbg_log"} = $enabled
22 ? sub {
23 $self->log( $caller, @_ );
24 }
25 : \&stub;
26
27 *{"${caller}::dbg_error"} = $enabled
28 ? sub {
29 $self->log( $caller, @_ );
30 }
31 : \&stub;
32
33 *{"${caller}::dbg_warn"} = $enabled
34 ? sub {
35 $self->log( $caller, @_ );
36 }
37 : \&stub;
38 }
39
40 sub log {
41 my $self = shift;
42 my $channel = shift;
43 $_->(@_) foreach @{ $subscriptions{$channel} || [] };
44 $_->(@_) foreach @subscriptions;
45 }
46
47 sub subscribe {
48 my ( $self, $channel, $callback ) = @_;
49
50 if ( @_ == 2 ) {
51 $callback = $channel;
52 $channel = undef;
53 }
54
55 die IMPL::InvalidArgumentException->new('callback')
56 unless ref $callback eq 'CODE';
57
58 if ($channel) {
59 push @{ $subscriptions{$channel} }, $callback;
60 }
61 else {
62 push @subscriptions, $callback;
63 }
64 }
65
66 1;