X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FObject-Remote.git;a=blobdiff_plain;f=lib%2FObject%2FRemote%2FLogging%2FRouter.pm;h=15bd2519c12dea76badb965ae63f30010e4d7234;hp=ee403775d4b7b69446db80702b39628974003be4;hb=572a9a00cec239943f92157ec39c44398aad137f;hpb=b43174a123aae89a1d3666ffd4d7b9d11ad4846c diff --git a/lib/Object/Remote/Logging/Router.pm b/lib/Object/Remote/Logging/Router.pm index ee40377..15bd251 100644 --- a/lib/Object/Remote/Logging/Router.pm +++ b/lib/Object/Remote/Logging/Router.pm @@ -2,26 +2,22 @@ package Object::Remote::Logging::Router; use Moo; use Scalar::Util qw(weaken); +use Sys::Hostname; with 'Log::Contextual::Role::Router'; with 'Object::Remote::Role::LogForwarder'; -has _controller_package => ( is => 'rwp' ); -#lookup table for package names that should not -#be forwarded across Object::Remote connections has _connections => ( is => 'ro', required => 1, default => sub { [] } ); has _remote_metadata => ( is => 'rw' ); -sub before_import { - my ($self, $controller, $importer, $spec) = @_; -} +sub before_import { } sub after_import { } sub _get_loggers { my ($self, %metadata) = @_; - my $package = $metadata{package}; - my $level = $metadata{level}; + my $package = $metadata{caller_package}; + my $level = $metadata{message_level}; my $is_level = "is_$level"; my $need_clean = 0; my @loggers; @@ -34,9 +30,7 @@ sub _get_loggers { foreach my $logger ($selector->($package, { %metadata })) { next unless defined $logger; - my $method = $logger->can($is_level); - next unless defined $method; - next unless $logger->$method; + next unless $logger->$is_level; push(@loggers, $logger); } } @@ -46,35 +40,65 @@ sub _get_loggers { return @loggers; } +#overloadable so a router can invoke a logger +#in a different way +sub _invoke_logger { + my ($self, $logger, $level_name, $content, $metadata) = @_; + #Invoking the logger like this gets all available data to the + #logging object with out losing any information from the datastructure. + #This is not a backwards compatible way to invoke the loggers + #but it enables a lot of flexibility in the logger. + #The l-c router could have this method invoke the logger in + #a backwards compatible way and router sub classes invoke + #it in non-backwards compatible ways if desired + $logger->$level_name($content, $metadata); +} + +#overloadable so forwarding can have the updated +#metadata but does not have to wrap get_loggers +#which has too many drawbacks +sub _deliver_message { + my ($self, %message_info) = @_; + my @loggers = $self->_get_loggers(%message_info); + my $generator = $message_info{message_sub}; + my $args = $message_info{message_args}; + my $level = $message_info{message_level}; + + return unless @loggers > 0; + #this is the point where the user provided log message code block is executed + my @content = $generator->(@$args); + foreach my $logger (@loggers) { + $self->_invoke_logger($logger, $level, \@content, \%message_info); + } +} + sub handle_log_request { - my ($self, $metadata_in, $generator, @args) = @_; - my %metadata = %{$metadata_in}; - my $level = $metadata{level}; - my $package = $metadata{package}; + my ($self, %message_info) = @_; + my $level = $message_info{message_level}; + my $package = $message_info{caller_package}; my $need_clean = 0; #caller_level is useless when log forwarding is in place - #so we won't tempt people with using it for now - access - #to caller level will be available in the future - my $caller_level = delete $metadata{caller_level}; - $metadata{object_remote} = $self->_remote_metadata; - $metadata{timestamp} = time; + #so we won't tempt people with using it + my $caller_level = delete $message_info{caller_level}; + $message_info{object_remote} = $self->_remote_metadata; + $message_info{timestamp} = time; + $message_info{pid} = $$; + $message_info{hostname} = hostname; my @caller_info = caller($caller_level); - $metadata{filename} = $caller_info[1]; - $metadata{line} = $caller_info[2]; + $message_info{filename} = $caller_info[1]; + $message_info{line} = $caller_info[2]; @caller_info = caller($caller_level + 1); - $metadata{method} = $caller_info[3]; - $metadata{method} =~ s/^${package}::// if defined $metadata{method}; - - foreach my $logger ($self->_get_loggers(%metadata)) { - $logger->$level([ $generator->(@args) ], \%metadata); - } + $message_info{method} = $caller_info[3]; + $message_info{method} =~ s/^${package}::// if defined $message_info{method}; + + $self->_deliver_message(%message_info); } sub connect { - my ($self, $destination) = @_; + my ($self, $destination, $is_weak) = @_; my $wrapped; if (ref($destination) ne 'CODE') { @@ -84,7 +108,7 @@ sub connect { } push(@{$self->_connections}, $wrapped); - weaken($self->_connections->[-1]); + weaken($self->_connections->[-1]) if $is_weak; } sub _clean_connections {