From: Tyler Riddle Date: Mon, 5 Nov 2012 03:58:26 +0000 (-0800) Subject: replaced entire logging subsystem with one that is fully operational with the followi... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=219880353e6492ecbf5db11b6ef41a98f2767afd;p=scpubgit%2FObject-Remote.git replaced entire logging subsystem with one that is fully operational with the following features: log forwarding, log forwarding supression, stderr output for object-remote generated logs per env var, dynamic logger connections to log router, selection based on package, log-contextual subclass, or remote connection --- diff --git a/lib/Object/Remote/Connection.pm b/lib/Object/Remote/Connection.pm index ad26929..34c99e9 100644 --- a/lib/Object/Remote/Connection.pm +++ b/lib/Object/Remote/Connection.pm @@ -1,6 +1,6 @@ package Object::Remote::Connection; -use Object::Remote::Logging qw (:log :dlog); +use Object::Remote::Logging qw (:log :dlog get_router); use Object::Remote::Future; use Object::Remote::Null; use Object::Remote::Handle; @@ -18,6 +18,8 @@ use JSON::PP qw(encode_json); use Moo; BEGIN { + get_router()->exclude_forwarding; + #this will reap child processes as soon #as they are done executing so the process #table cleans up as fast as possible but diff --git a/lib/Object/Remote/Future.pm b/lib/Object/Remote/Future.pm index d6d6081..570bbb5 100644 --- a/lib/Object/Remote/Future.pm +++ b/lib/Object/Remote/Future.pm @@ -4,7 +4,9 @@ use strict; use warnings; use base qw(Exporter); -use Object::Remote::Logging qw( :log Dlog_trace ); +use Object::Remote::Logging qw( :log get_router ); + +BEGIN { get_router()->exclude_forwarding } use CPS::Future; diff --git a/lib/Object/Remote/Handle.pm b/lib/Object/Remote/Handle.pm index 1a20eba..8e0a84f 100644 --- a/lib/Object/Remote/Handle.pm +++ b/lib/Object/Remote/Handle.pm @@ -2,7 +2,7 @@ package Object::Remote::Handle; use Object::Remote::Proxy; use Scalar::Util qw(weaken blessed); -use Object::Remote::Logging qw ( :log ); +use Object::Remote::Logging qw ( :log get_router ); use Object::Remote::Future; #must find way to exclude certain log events #from being forwarded - log events generated in @@ -11,6 +11,8 @@ use Object::Remote::Future; use Module::Runtime qw(use_module); use Moo; +BEGIN { get_router()->exclude_forwarding } + has connection => ( is => 'ro', required => 1, coerce => sub { diff --git a/lib/Object/Remote/LogDestination.pm b/lib/Object/Remote/LogDestination.pm deleted file mode 100644 index 7cdbbd1..0000000 --- a/lib/Object/Remote/LogDestination.pm +++ /dev/null @@ -1,23 +0,0 @@ -package Object::Remote::LogDestination; - -use Moo; -use Scalar::Util qw(weaken); - -has logger => ( is => 'ro', required => 1 ); -has subscriptions => ( is => 'ro', required => 1, default => sub { [] } ); - -sub select { - my ($self, $router, $selector) = @_; - my $subscription = $router->subscribe($self->logger, $selector); - push(@{ $self->subscriptions }, $subscription); - return $self; -} - -sub connect { - my ($self, $router) = @_; - return $self->select($router, sub { 1 }); -} - -1; - - diff --git a/lib/Object/Remote/LogRouter.pm b/lib/Object/Remote/LogRouter.pm deleted file mode 100644 index 3b1f655..0000000 --- a/lib/Object/Remote/LogRouter.pm +++ /dev/null @@ -1,60 +0,0 @@ -package Object::Remote::LogRouter; - -use Moo; -use Scalar::Util qw(blessed); - -with 'Object::Remote::Role::LogForwarder'; - -has subscriptions => ( is => 'ro', required => 1, default => sub { [] } ); -has description => ( is => 'rw', required => 1 ); - -sub before_import { } -sub after_import { } - -sub subscribe { - my ($self, $logger, $selector) = @_; - my $subscription_list = $self->subscriptions; - - my $subscription = [ $logger, $selector ]; - - push(@$subscription_list, $subscription); - - return $self; -} - -#TODO turn this logic into a role -sub get_loggers { - my ($self, $caller, $level) = @_; - my $should_clean = 0; - my @logger_list; - - foreach(@{ $self->subscriptions }) { - unless(defined) { - $should_clean = 1; - next; - } - - my ($logger, $selector) = @$_; - - if ($selector->({ log_level => $level, package => $caller, caller_level => 2 })) { - push(@logger_list, $logger); - } - } - - if ($should_clean) { - $self->_remove_dead_subscriptions; - } - - return @logger_list; -} - -sub _remove_dead_subscriptions { - my ($self) = @_; - my @ok = grep { defined $_ } @{$self->subscriptions}; - @{$self->subscriptions} = @ok; - return; -} - - -1; - diff --git a/lib/Object/Remote/Logging.pm b/lib/Object/Remote/Logging.pm index f2fec49..f765db8 100644 --- a/lib/Object/Remote/Logging.pm +++ b/lib/Object/Remote/Logging.pm @@ -1,220 +1,49 @@ package Object::Remote::Logging; -use strictures 1; +use Moo; +use Scalar::Util qw(blessed); +use Object::Remote::Logging::Logger; -use Object::Remote::LogRouter; -use Object::Remote::LogDestination; -use Log::Contextual::SimpleLogger; -use Carp qw(cluck); +extends 'Log::Contextual'; -use base qw(Log::Contextual); +sub router { + our $Router_Instance ||= do { + require Object::Remote::Logging::Router; + Object::Remote::Logging::Router->new; + } +} -sub arg_router { - return $_[1] if defined $_[1]; - our $Router_Instance; - - return $Router_Instance if defined $Router_Instance; - - $Router_Instance = Object::Remote::LogRouter->new( - description => $_[0], - ); +sub arg_levels { + return [qw( trace debug verbose info warn error )]; } +#this is invoked on all nodes sub init_logging { - my ($class) = @_; - our $Did_Init; - - return if $Did_Init; - $Did_Init = 1; + my $level = $ENV{OBJECT_REMOTE_LOG_LEVEL}; + return unless defined $level; + my $logger = Object::Remote::Logging::Logger->new( + min_level => lc($level), + level_names => Object::Remote::Logging::arg_levels(), + ); - if ($ENV{OBJECT_REMOTE_LOG_LEVEL}) { - $class->init_logging_stderr($ENV{OBJECT_REMOTE_LOG_LEVEL}); - } -} - -sub init_logging_stderr { - my ($class, $level) = @_; - our $Log_Level = $level; - chomp(my $hostname = `hostname`); - - our $Log_Output = Object::Remote::LogDestination->new( - logger => Log::Contextual::SimpleLogger->new({ - levels_upto => $Log_Level, - coderef => sub { - my @t = localtime(); - my $time = sprintf("%0.2i:%0.2i:%0.2i", $t[2], $t[1], $t[0]); - print STDERR "[$hostname $$] $time ", @_ - }, - }) - ); - - $Log_Output->connect($class->arg_router); + #TODO check on speed of string compare against a hash with a single key + router()->connect(sub { + return unless $_[1]->{controller} eq __PACKAGE__; + #skip things from remote hosts because they log to STDERR + #when OBJECT_REMOTE_LOG_LEVEL is in effect + return if $_[1]->{remote}->{connection_id}; + $logger + }); } +#this is invoked by the controlling node +#on the remote nodes sub init_logging_forwarding { -# my ($class, $remote_parent) = @_; -# chomp(my $host = `hostname`); -# $class->arg_router->description("$$ $host"); -# $class->arg_router->parent_router($remote_parent); -# $remote_parent->add_child_router($class->arg_router); + my ($self, %controller_info) = @_; + + router()->_remote_metadata({ connection_id => $controller_info{connection_id} }); + router()->_forward_destination($controller_info{router}); } 1; -__END__ - -Hierarchical routed logging concept - - Why? - - Object::Remote and systems built on it would benefit from a standard model - for logging that enables simple and transparent log generation and consumption - that can cross the Perl interpreter instance boundaries. More - generally CPAN would benefit from a common logging framework that allows all - log message generators to play nicely with all log message consumers with out - making the generators or consumers jump through hoops to do what they want to do. - If these two solutions are the same then all modules built using the - logging framework will transparently operate properly when run under Object::Remote. - - Such a solution needs to be flexible and have a low performance impact when it is not - actively logging. The hiearchy of log message routers is the way to achieve all of these - goals. The abstracted message router interface introduced to Log::Contextual allows - the hierarchical routing system to be built and tested inside Object::Remote with possible - larger scale deployment in the future. - - Hierarchy of log routers - - * Each Perl module ideally would use at least a router dedicated - to that module and may have child routers if the module is complex. - - * Log messages inserted at low levels in the hierarchy - are available at routers at higher levels in the hierarchy. - - * Each running Perl instance has a root router which receives - all log messages generated in the Perl instance. - - * The routing hierarchy is available for introspection and connections - from child routers to parent routers have human readable descriptions - - * The entire routing system is dynamic - * Add and remove routers while the system is in operation - * Add and remove subscriptions into routers while the system is in operation - - * Auto-solves Object::Remote logging by setting the parent router of the - root router in the remote instance to a router in the local instance. The - log messages will flow into the local router via a proxy object. - - * There needs to be two modes of operation for routed logging - * forwarding across Perl instances using Object::Remote proxies - for ease of use during normal operation - - * STDERR output by default because not all logs can be forwarded - such as log messages for parts of Object::Remote that relate to - Object::Remote delivering the log. - - - - Example hiearchy - - * Root [1] - * System::Introspector - * Object::Remote [2] - * local [3] - * remote [4] - * connection #1 [5] - * Root - * System::Introspector - * Object::Remote - * local - * connection #2 - * Root - * System::Introspector - * Object::Remote - * local - - [1] This router has all logs generated anywhere - even on remote hosts - [2] Everything related to Object::Remote including - log messages from remote nodes for things other - than Object::Remote - [3] Log messages generated by Object::Remote on the local - node only - [4] All log messages from all remote nodes - [5] This is the connection from a remote instance to the - local instance using a proxy object - the name contains - the Object::Remote::Connection id for the remote node - - As a demonstration of the flexibility of the this system consider a CPAN testers GUI - tool. This hypothetical tool would allow a tester to select a module by name and perform - the automated tests for that package and all dependent packages. Inside the tool is a pane for - the output of the process (STDOUT and STDERR), a pane for log messages, and a pane displaying - the modules that are participating in routed logging. The tester could then click on individual - packages and enable logging for that package dynamically. If neccassary more than one package - could be monitored if neccassary. If the GUI is wrapping a program that runs for long periods of - time or if the application is a daemon then being able to dynamically add and remove logging - becomes very useful. - - Log message selection and output - - * Assumptions - * Modules and packages know how they want to format log messages. - * Consumers of log messages want to know - * Which Perl module/package generated that message. - * When running with Object::Remote if the log message is from - a remote connection and if so which connection. - * Consumers of a log message know how they want to output them. The logger - should not be enforcing a specific type of log output. - * Most log messages most of the time will be completely ignored and unused. - * Router subscriptions - * A consumer of log messages will subscribe to a router at any arbitrary point - in the router hierarchy even across machines if Object::Remote is involved - * The subscription is used to access a stream of log data and is not used to select - which packages/modules should be logged - * For instance the Object::Remote log router has log messages flowing through - it that include logs generated on remote nodes even if those logs were generated - by a module other than Object::Remote - - * Selection - * The module has defined what the log message format is - * The subscription has defined the scope of messages that will be - available for selection, ie: all log messages everywhere, - all logs generated on Object::Remote nodes, etc - * Selection defines what log messages are going to be delivered - to a logger object instance - * Selectors act as a gate between a subscription and the logger object - * Selectors are closures that perform introspection on the log - message and metadata; if the selector returns true the logger - will be invoked to log this message - * The logger still has a log level assigned to it and still will have - the is_$level method invoked to only log at that specific level - - * Destinations - * A log destination is an instance of a logger object and the associated - subscriptions. - * Consuming logging data from this system is a matter of - * Constructing an instance of a logging destination object which has - the following attributes: - * logger - the logger object - * selectors - a list of closures; the first one that returns true - causes the logger to be checked for this log_level and - invoked if needed - * Register selectors with the destination by invoking a method and specifying - sub refs as an argument - - Technical considerations - * The routing hierarchy has cycles where parent routers hold a reference to the child - and the child holds a reference to the parent. The cycles are not a problem if weak - references are used however proxy objects don't seem to currently work with weak - references. - * Once a logger hits a proxy object the caller information is totally blown; this - crossing isn't transparent yet - * If Object::Remote is logging its actions and those logs are being forwarded then - logs can be generated from the forwarding itself creating an infinite loop. Only - a portion of Object::Remote can be forwarded. - - - - - - - diff --git a/lib/Object/Remote/Logging/Logger.pm b/lib/Object/Remote/Logging/Logger.pm new file mode 100644 index 0000000..3afa0d7 --- /dev/null +++ b/lib/Object/Remote/Logging/Logger.pm @@ -0,0 +1,83 @@ +package Object::Remote::Logging::Logger; + +use Moo; +use Scalar::Util qw(weaken); + +has level_names => ( is => 'ro', required => 1 ); +has min_level => ( is => 'ro', required => 1 ); +has max_level => ( is => 'ro' ); +has _level_active => ( is => 'lazy' ); + +sub BUILD { + my ($self) = @_; + our $METHODS_INSTALLED; + $self->_install_methods unless $METHODS_INSTALLED; +} + +sub _build__level_active { + my ($self) = @_; + my $should_log = 0; + my $min_level = $self->min_level; + my $max_level = $self->max_level; + my %active; + + foreach my $level (@{$self->level_names}) { + if($level eq $min_level) { + $should_log = 1; + } + + $active{$level} = $should_log; + + if (defined $max_level && $level eq $max_level) { + $should_log = 0; + } + } + + return \%active; +} + +sub _install_methods { + my ($self) = @_; + my $should_log = 0; + our $METHODS_INSTALLED = 1; + + no strict 'refs'; + + foreach my $level (@{$self->level_names}) { + *{"is_$level"} = sub { shift(@_)->_level_active->{$level} }; + *{$level} = sub { shift(@_)->_log($level, @_) }; + } +} + +sub _log { + my ($self, $level, $content, $metadata_in) = @_; + #TODO this stinks but is backwards compatible with the original logger api + my %metadata = %$metadata_in; + my $rendered = $self->_render($level, \%metadata, @$content); + $self->_output($rendered); +} + +sub _render { + my ($self, $level, $metadata, @content) = @_; + my $rendered = "[$level] "; + my $remote_info = $metadata->{object_remote}; + + if ($remote_info) { + $rendered .= "[connection #$remote_info->{connection_id}] "; + } else { + $rendered .= "[local] "; + } + + $rendered .= join('', @content); + $rendered .= "\n" unless substr($rendered, -1) eq "\n"; + return $rendered; +} + +sub _output { + my ($self, $content) = @_; + print STDERR $content; +} + + +1; + diff --git a/lib/Object/Remote/Logging/Router.pm b/lib/Object/Remote/Logging/Router.pm new file mode 100644 index 0000000..d8579e3 --- /dev/null +++ b/lib/Object/Remote/Logging/Router.pm @@ -0,0 +1,82 @@ +package Object::Remote::Logging::Router; + +use Moo; + +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 after_import { } + +sub _get_loggers { + my ($self, %metadata) = @_; + my $package = $metadata{package}; + my $level = $metadata{level}; + my $is_level = "is_$level"; + my $need_clean = 0; + my @loggers; + + foreach my $selector (@{$self->_connections}) { + unless(defined $selector) { + $need_clean = 1; + next; + } + + foreach my $logger ($selector->($package, { %metadata })) { + next unless defined $logger; + next unless $logger->$is_level; + push(@loggers, $logger); + } + } + + $self->_clean_connections if $need_clean; + + return @loggers; +} + +sub handle_log_request { + my ($self, $metadata_in, $generator, @args) = @_; + my %metadata = %{$metadata_in}; + my $level = $metadata{level}; + my $package = $metadata{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 + delete $metadata{caller_level}; + $metadata{object_remote} = $self->_remote_metadata; + + foreach my $logger ($self->_get_loggers(%metadata)) { + $logger->$level([ $generator->(@args) ], \%metadata); + } +} + +sub connect { + my ($self, $destination) = @_; + my $wrapped; + + if (ref($destination) ne 'CODE') { + $wrapped = sub { $destination }; + } else { + $wrapped = $destination; + } + + push(@{$self->_connections}, $wrapped); +} + +sub _clean_connections { + my ($self) = @_; + @{$self->{_connections}} = grep { defined } @{$self->{_connections}}; +} + +1; diff --git a/lib/Object/Remote/MiniLoop.pm b/lib/Object/Remote/MiniLoop.pm index ab8e85a..5a47f56 100644 --- a/lib/Object/Remote/MiniLoop.pm +++ b/lib/Object/Remote/MiniLoop.pm @@ -2,9 +2,11 @@ package Object::Remote::MiniLoop; use IO::Select; use Time::HiRes qw(time); -use Object::Remote::Logging qw( :log :dlog ); +use Object::Remote::Logging qw( :log :dlog get_router ); use Moo; +BEGIN { get_router()->exclude_forwarding } + # this is ro because we only actually set it using local in sub run has is_running => (is => 'ro', clearer => 'stop'); #maximum duration that select() will block - undef means indefinite, diff --git a/lib/Object/Remote/ReadChannel.pm b/lib/Object/Remote/ReadChannel.pm index 5d7e9f0..456e5aa 100644 --- a/lib/Object/Remote/ReadChannel.pm +++ b/lib/Object/Remote/ReadChannel.pm @@ -2,9 +2,11 @@ package Object::Remote::ReadChannel; use CPS::Future; use Scalar::Util qw(weaken openhandle); -use Object::Remote::Logging qw(:log :dlog); +use Object::Remote::Logging qw(:log :dlog get_router ); use Moo; +BEGIN { get_router()->exclude_forwarding } + has fh => ( is => 'ro', required => 1, trigger => sub { diff --git a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm index 50bc3cf..a7b4316 100644 --- a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm +++ b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm @@ -4,7 +4,7 @@ use IPC::Open2; use IPC::Open3; use IO::Handle; use Symbol; -use Object::Remote::Logging qw( :log :dlog ); +use Object::Remote::Logging qw( :log :dlog get_router ); use Object::Remote::ModuleSender; use Object::Remote::Handle; use Object::Remote::Future; @@ -57,7 +57,7 @@ around connect => sub { my ($conn) = $f->get; $self->_setup_watchdog_reset($conn); my $sub = $conn->remote_sub('Object::Remote::Logging::init_logging_forwarding'); - $sub->('Object::Remote::Logging', Object::Remote::Logging->arg_router); + $sub->('Object::Remote::Logging', router => get_router, connection_id => $conn->_id); Object::Remote::Handle->new( connection => $conn, class => 'Object::Remote::ModuleLoader', diff --git a/lib/Object/Remote/Role/LogForwarder.pm b/lib/Object/Remote/Role/LogForwarder.pm index 5be6851..1a8bd93 100644 --- a/lib/Object/Remote/Role/LogForwarder.pm +++ b/lib/Object/Remote/Role/LogForwarder.pm @@ -1,64 +1,41 @@ -#This is an experimental method for working with -#Log::Contextual crossing Object::Remote connections -#transparently - package Object::Remote::Role::LogForwarder; -use Moo::Role; -use Scalar::Util qw(weaken); +use Moo::Role; use Carp qw(cluck); -with 'Log::Contextual::Role::Router'; - -#TODO re-weaken router references when object::remote -#weak reference operation is figured out - -has child_routers => ( is => 'ro', required => 1, default => sub { [] } ); -has parent_router => ( is => 'rw', );#weak_ref => 1 ); - -sub BUILD { } - -after BUILD => sub { - my ($self) = @_; -# my $parent = $self->parent_router; -# return unless defined $parent ; -# $parent->add_child_router($self); -}; +has _forward_destination => ( is => 'rw' ); +has enable_forward => ( is => 'rw', default => sub { 1 } ); +has _forward_stop => ( is => 'ro', required => 1, default => sub { {} } ); + +around _get_loggers => sub { + my ($orig, $self, %metadata) = @_; + my $package = $metadata{package}; + my %clone = %metadata; + our $reentrant; + + return if $reentrant; + local($reentrant) = 1; + + my @loggers = $orig->($self, %clone); -sub describe { - my ($self, $depth) = @_; - $depth = -1 unless defined $depth; - $depth++; - my $buf = "\t" x $depth . $self->description . "\n"; - foreach my $child (@{$self->child_routers}) { - next unless defined $child; - $buf .= $child->describe($depth); + if (! $self->enable_forward || $self->_forward_stop->{$package}) { + #warn "will not forward log events for '$package'"; + return @loggers; } - - return $buf; -} + + my $forward_to = $self->_forward_destination; + + if ($forward_to) { + push(@loggers, $forward_to->_get_loggers(%clone)); + } + + return @loggers; +}; -sub add_child_router { - my ($self, $router) = @_; - push(@{ $self->child_routers }, $router); - #TODO re-weaken when object::remote proxied - #weak references is figured out -# weaken(${ $self->child_routers }[-1]); - return; +sub exclude_forwarding { + my ($self, $package) = @_; + $package = caller unless defined $package; + $self->_forward_stop->{$package} = 1; } -#sub remove_child_router { -# my ($self, $description) = @_; -# return delete $self->child_routers->{$description}; -#} - -after get_loggers => sub { - my ($self, @args) = @_; - my $parent = $self->parent_router; - - return unless defined $parent; - $parent->handle_log_message(@args); -}; - 1; - diff --git a/t/logsetup.pl b/t/logsetup.pl index a55a28b..e583663 100644 --- a/t/logsetup.pl +++ b/t/logsetup.pl @@ -1,24 +1,22 @@ #require this file in the test to initialize the logging framework -#so the tests can run +#so the tests can run and all log items can be executed during testing -package Object::Remote::Logger::TestOutput; +package Object::Remote::Logging::TestOutput; -use base qw ( Log::Contextual::SimpleLogger ); +use base qw ( Object::Remote::Logging::Logger ); -#we want the code blocks in the log lines to execute but not -#output anything so turn this into a null logger -sub _log { } +#don't need to output anything +sub _output { } package main; -use Object::Remote::Logging qw( :log ); -use Object::Remote::LogDestination; +use Object::Remote::Logging qw( get_router ); #make sure to enable execution of every logging code block #by setting the log level as high as it can go - my $____LOG_DESTINATION = Object::Remote::LogDestination->new( - logger => Object::Remote::Logger::TestOutput->new({ levels_upto => 'trace' }), - ); - - $____LOG_DESTINATION->connect(Object::Remote::Logging->arg_router); +get_router->connect(Object::Remote::Logging::TestOutput->new( + min_level => 'trace', max_level => 'error', + level_names => Object::Remote::Logging->arg_levels(), +)); + 1;