File Coverage

blib/lib/Object/Remote/Role/LogForwarder.pm
Criterion Covered Total %
statement 6 6 100.0
branch 1 2 50.0
condition n/a
subroutine 2 2 100.0
pod 0 1 0.0
total 9 11 81.8


line stmt bran cond sub pod time code
1             package Object::Remote::Role::LogForwarder;
2              
3 18     18   7205 use Moo::Role;
  18         26  
  18         101  
4              
5             has enable_forward => ( is => 'rw', default => sub { 1 } );
6             has _forward_destination => ( is => 'rw' );
7             #lookup table for package names that should not
8             #be forwarded across Object::Remote connections
9             has _forward_stop => ( is => 'ro', required => 1, default => sub { {} } );
10              
11             after _deliver_message => sub {
12             # my ($self, $level, $generator, $args, $metadata) = @_;
13             my ($self, %message_info) = @_;
14             my $package = $message_info{caller_package};
15             my $destination = $self->_forward_destination;
16             our $reentrant;
17              
18             if (defined $message_info{object_remote}) {
19             $message_info{object_remote} = { %{$message_info{object_remote}} };
20             }
21              
22             $message_info{object_remote}->{forwarded} = 1;
23              
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;
31             }
32              
33             local $reentrant = $package;
34              
35             eval { $destination->_deliver_message(%message_info) };
36              
37             if ($@ && $@ !~ /^Attempt to use Object::Remote::Proxy backed by an invalid handle/) {
38             die $@;
39             }
40             };
41              
42             sub exclude_forwarding {
43 98     98 0 170 my ($self, $package) = @_;
44 98 50       339 $package = caller unless defined $package;
45 98         67129 $self->_forward_stop->{$package} = 1;
46             }
47              
48             1;