Commit | Line | Data |
f7ea4120 |
1 | package Object::Remote::Role::LogForwarder; |
2 | |
4e446335 |
3 | use Moo::Role; |
f7ea4120 |
4 | |
4e446335 |
5 | has enable_forward => ( is => 'rw', default => sub { 1 } ); |
a27266b7 |
6 | has _forward_destination => ( is => 'rw' ); |
052976d4 |
7 | #lookup table for package names that should not |
8 | #be forwarded across Object::Remote connections |
4e446335 |
9 | has _forward_stop => ( is => 'ro', required => 1, default => sub { {} } ); |
10 | |
f048e6df |
11 | after _deliver_message => sub { |
a663aea5 |
12 | # my ($self, $level, $generator, $args, $metadata) = @_; |
13 | my ($self, %message_info) = @_; |
14 | my $package = $message_info{caller_package}; |
f048e6df |
15 | my $destination = $self->_forward_destination; |
4e446335 |
16 | our $reentrant; |
55c0d020 |
17 | |
a663aea5 |
18 | if (defined $message_info{object_remote}) { |
19 | $message_info{object_remote} = { %{$message_info{object_remote}} }; |
08435f11 |
20 | } |
55c0d020 |
21 | |
a663aea5 |
22 | $message_info{object_remote}->{forwarded} = 1; |
4a9fa1a5 |
23 | |
f048e6df |
24 | return unless $self->enable_forward; |
25 | return unless defined $destination; |
26 | return if $self->_forward_stop->{$package}; |
27 | |
28 | if (defined $reentrant) { |
29 | warn "log forwarding went reentrant. bottom: '$reentrant' top: '$package'"; |
30 | return; |
5d59cb98 |
31 | } |
55c0d020 |
32 | |
f048e6df |
33 | local $reentrant = $package; |
55c0d020 |
34 | |
a663aea5 |
35 | eval { $destination->_deliver_message(%message_info) }; |
55c0d020 |
36 | |
5add5e29 |
37 | if ($@ && $@ !~ /^Attempt to use Object::Remote::Proxy backed by an invalid handle/) { |
38 | die $@; |
39 | } |
4e446335 |
40 | }; |
4a9fa1a5 |
41 | |
4e446335 |
42 | sub exclude_forwarding { |
c0b2df05 |
43 | my ($self, $package) = @_; |
44 | $package = caller unless defined $package; |
45 | $self->_forward_stop->{$package} = 1; |
f7ea4120 |
46 | } |
47 | |
f7ea4120 |
48 | 1; |