X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FObject%2FRemote%2FRole%2FLogForwarder.pm;h=ce5bbc28133749165342b83e24567c89511d0162;hb=HEAD;hp=1a8bd93708b762a3d672349b33116a1f6d4f8efb;hpb=4e4463355a9ec6afdc7983ee36daa9f11306d4fc;p=scpubgit%2FObject-Remote.git diff --git a/lib/Object/Remote/Role/LogForwarder.pm b/lib/Object/Remote/Role/LogForwarder.pm index 1a8bd93..ce5bbc2 100644 --- a/lib/Object/Remote/Role/LogForwarder.pm +++ b/lib/Object/Remote/Role/LogForwarder.pm @@ -1,41 +1,48 @@ package Object::Remote::Role::LogForwarder; use Moo::Role; -use Carp qw(cluck); -has _forward_destination => ( is => 'rw' ); has enable_forward => ( is => 'rw', default => sub { 1 } ); +has _forward_destination => ( is => 'rw' ); +#lookup table for package names that should not +#be forwarded across Object::Remote connections has _forward_stop => ( is => 'ro', required => 1, default => sub { {} } ); -around _get_loggers => sub { - my ($orig, $self, %metadata) = @_; - my $package = $metadata{package}; - my %clone = %metadata; +after _deliver_message => sub { +# my ($self, $level, $generator, $args, $metadata) = @_; + my ($self, %message_info) = @_; + my $package = $message_info{caller_package}; + my $destination = $self->_forward_destination; our $reentrant; - - return if $reentrant; - local($reentrant) = 1; - - my @loggers = $orig->($self, %clone); - - if (! $self->enable_forward || $self->_forward_stop->{$package}) { - #warn "will not forward log events for '$package'"; - return @loggers; + + if (defined $message_info{object_remote}) { + $message_info{object_remote} = { %{$message_info{object_remote}} }; + } + + $message_info{object_remote}->{forwarded} = 1; + + return unless $self->enable_forward; + return unless defined $destination; + return if $self->_forward_stop->{$package}; + + if (defined $reentrant) { + warn "log forwarding went reentrant. bottom: '$reentrant' top: '$package'"; + return; } - - my $forward_to = $self->_forward_destination; - - if ($forward_to) { - push(@loggers, $forward_to->_get_loggers(%clone)); + + local $reentrant = $package; + + eval { $destination->_deliver_message(%message_info) }; + + if ($@ && $@ !~ /^Attempt to use Object::Remote::Proxy backed by an invalid handle/) { + die $@; } - - return @loggers; }; sub exclude_forwarding { - my ($self, $package) = @_; - $package = caller unless defined $package; - $self->_forward_stop->{$package} = 1; + my ($self, $package) = @_; + $package = caller unless defined $package; + $self->_forward_stop->{$package} = 1; } 1;