Commit | Line | Data |
f7ea4120 |
1 | package Object::Remote::Role::LogForwarder; |
2 | |
4e446335 |
3 | use Moo::Role; |
4a9fa1a5 |
4 | use Carp qw(cluck); |
f7ea4120 |
5 | |
4e446335 |
6 | has _forward_destination => ( is => 'rw' ); |
7 | has enable_forward => ( is => 'rw', default => sub { 1 } ); |
8 | has _forward_stop => ( is => 'ro', required => 1, default => sub { {} } ); |
9 | |
10 | around _get_loggers => sub { |
11 | my ($orig, $self, %metadata) = @_; |
12 | my $package = $metadata{package}; |
13 | my %clone = %metadata; |
14 | our $reentrant; |
15 | |
16 | return if $reentrant; |
17 | local($reentrant) = 1; |
18 | |
19 | my @loggers = $orig->($self, %clone); |
4a9fa1a5 |
20 | |
4e446335 |
21 | if (! $self->enable_forward || $self->_forward_stop->{$package}) { |
22 | #warn "will not forward log events for '$package'"; |
23 | return @loggers; |
5d59cb98 |
24 | } |
4e446335 |
25 | |
26 | my $forward_to = $self->_forward_destination; |
27 | |
28 | if ($forward_to) { |
29 | push(@loggers, $forward_to->_get_loggers(%clone)); |
30 | } |
31 | |
32 | return @loggers; |
33 | }; |
4a9fa1a5 |
34 | |
4e446335 |
35 | sub exclude_forwarding { |
c0b2df05 |
36 | my ($self, $package) = @_; |
37 | $package = caller unless defined $package; |
38 | $self->_forward_stop->{$package} = 1; |
f7ea4120 |
39 | } |
40 | |
f7ea4120 |
41 | 1; |