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 | |
f048e6df |
10 | after _deliver_message => sub { |
11 | my ($self, $level, $generator, $args, $metadata) = @_; |
12 | my $package = $metadata->{package}; |
13 | my $destination = $self->_forward_destination; |
4e446335 |
14 | our $reentrant; |
4a9fa1a5 |
15 | |
f048e6df |
16 | return unless $self->enable_forward; |
17 | return unless defined $destination; |
18 | return if $self->_forward_stop->{$package}; |
19 | |
20 | if (defined $reentrant) { |
21 | warn "log forwarding went reentrant. bottom: '$reentrant' top: '$package'"; |
22 | return; |
5d59cb98 |
23 | } |
4e446335 |
24 | |
f048e6df |
25 | local $reentrant = $package; |
4e446335 |
26 | |
f048e6df |
27 | $destination->_deliver_message($level, $generator, $args, $metadata); |
4e446335 |
28 | }; |
4a9fa1a5 |
29 | |
4e446335 |
30 | sub exclude_forwarding { |
c0b2df05 |
31 | my ($self, $package) = @_; |
32 | $package = caller unless defined $package; |
33 | $self->_forward_stop->{$package} = 1; |
f7ea4120 |
34 | } |
35 | |
f7ea4120 |
36 | 1; |