Mercurial > pub > Impl
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; |