From: Tyler Riddle Date: Sat, 15 Sep 2012 02:34:47 +0000 (-0700) Subject: start adding logs and add support for routed logs and logging to stderr X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=23591f5fde91a567cfe59db4e6f2779cd6a20712;p=scpubgit%2FObject-Remote.git start adding logs and add support for routed logs and logging to stderr --- diff --git a/lib/Object/Remote.pm b/lib/Object/Remote.pm index a0eaee5..675b2fb 100644 --- a/lib/Object/Remote.pm +++ b/lib/Object/Remote.pm @@ -2,13 +2,19 @@ package Object::Remote; use Object::Remote::MiniLoop; use Object::Remote::Handle; +use Object::Remote::Logging qw( :log ); use Module::Runtime qw(use_module); our $VERSION = '0.002003'; # 0.2.3 +BEGIN { + Object::Remote::Logging->init_logging; +} + sub new::on { my ($class, $on, @args) = @_; my $conn = __PACKAGE__->connect($on); + log_debug { sprintf("constructing instance of $class on connection for child pid of %i", $conn->child_pid) }; return $conn->remote_object(class => $class, args => \@args); } diff --git a/lib/Object/Remote/FatNode.pm b/lib/Object/Remote/FatNode.pm index 0d67a98..419598f 100644 --- a/lib/Object/Remote/FatNode.pm +++ b/lib/Object/Remote/FatNode.pm @@ -53,6 +53,13 @@ my @core_non_arch = grep +( and not(/^\Q$Config{archlibexp}/ or /\Q$Config{archname}/ or /\Q$Config{myarchname}/) ), keys %mods; +my $env_pass = ''; +if (defined($ENV{OBJECT_REMOTE_LOG_LEVEL})) { + my $level = $ENV{OBJECT_REMOTE_LOG_LEVEL}; + return unless $level =~ /^\w+$/; + $env_pass = '$ENV{OBJECT_REMOTE_LOG_LEVEL} = "' . $level . "\";\n"; +} + my $start = stripspace <<'END_START'; # This chunk of stuff was generated by Object::Remote::FatNode. To find # the original file's code, look for the end of this BEGIN block or the @@ -100,6 +107,6 @@ my @segments = ( map(generate_fatpack_hash('fatpacked_extra', $_), sort map $mods{$_}, @core_non_arch), ); -our $DATA = join "\n", $start, @segments, $end; +our $DATA = join "\n", $start, $env_pass, @segments, $end; 1; diff --git a/lib/Object/Remote/Future.pm b/lib/Object/Remote/Future.pm index 893fb6d..7afac68 100644 --- a/lib/Object/Remote/Future.pm +++ b/lib/Object/Remote/Future.pm @@ -4,6 +4,8 @@ use strict; use warnings; use base qw(Exporter); +use Object::Remote::Logging qw( :log ); + use CPS::Future; our @EXPORT = qw(future await_future await_all); diff --git a/lib/Object/Remote/Handle.pm b/lib/Object/Remote/Handle.pm index 4fac320..a3cf33a 100644 --- a/lib/Object/Remote/Handle.pm +++ b/lib/Object/Remote/Handle.pm @@ -3,6 +3,10 @@ package Object::Remote::Handle; use Object::Remote::Proxy; use Scalar::Util qw(weaken blessed); use Object::Remote::Future; +#must find way to exclude certain log events +#from being forwarded - log events generated in +#response to log events cause exploding +#use Object::Remote::Logging qw(:log); use Module::Runtime qw(use_module); use Moo; @@ -27,6 +31,7 @@ sub proxy { sub BUILD { my ($self, $args) = @_; +# log_debug { "constructing instance of " . ref($self) }; if ($self->id) { $self->disarm_free; } else { @@ -41,6 +46,7 @@ sub BUILD { )->{remote}->disarm_free->id ); } +# log_trace { "finished constructing " . ref($self) }; $self->connection->register_remote($self); } diff --git a/lib/Object/Remote/LogDestination.pm b/lib/Object/Remote/LogDestination.pm index 68f4bb3..af4235b 100644 --- a/lib/Object/Remote/LogDestination.pm +++ b/lib/Object/Remote/LogDestination.pm @@ -18,4 +18,6 @@ sub connect { return $self->select($router, sub { 1 }); } -1; \ No newline at end of file +1; + + diff --git a/lib/Object/Remote/LogRouter.pm b/lib/Object/Remote/LogRouter.pm index 2ba0c2c..9fa20e0 100644 --- a/lib/Object/Remote/LogRouter.pm +++ b/lib/Object/Remote/LogRouter.pm @@ -6,6 +6,7 @@ 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 { diff --git a/lib/Object/Remote/Logging.pm b/lib/Object/Remote/Logging.pm index 25831ac..0622648 100644 --- a/lib/Object/Remote/Logging.pm +++ b/lib/Object/Remote/Logging.pm @@ -4,12 +4,206 @@ use strictures 1; use Log::Contextual qw( :log ); use Object::Remote::LogRouter; +use Object::Remote::LogDestination; +use Log::Contextual::SimpleLogger; +use Carp qw(cluck); use base qw(Log::Contextual); -sub arg_router { return $_[1] if defined $_[1]; our $Router_Instance ||= Object::Remote::LogRouter->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 init_node { my $n = `hostname`; chomp($n); $_[0]->add_child_router("[node $n]", __PACKAGE__->arg_router) } +sub init_logging { + my ($class) = @_; + our $Did_Init; + + return if $Did_Init; + $Did_Init = 1; + + 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 { warn "[$hostname $$] ", @_ }, + }) + ); + $Log_Output->connect($class->arg_router); +} + +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); +} 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 transparently. 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 strings +# * The entire routing system is dynamic +# * Add and remove routers while the system is in operation +# * Add and remove taps 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 +# * Should probably be two modes of operation for Object::Remote logging +# * forwarding across instances for ease of use during normal operation +# * stderr output by default for debugging cases to limit the usage of +# object::remote +# +# +# Example hiearchy +# +# Root [1] +# * System::Introspector +# * Object::Remote [2] +# * local [3] +# * remote [4] +# * hostname-1.example.com [5] +# * Root +# * System::Introspector +# * Object::Remote +# * local +# * hostname-2.example.com +# * 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 +# +# 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 node and if so which node +# * Consuming a log message is something the consumer knows how it wants +# to be done; the module/package should not be dictating how to receive +# the log messages +# * Most log messages most of the time will be completely ignored and unused +# * Router taps +# * A consumer of log messages will tap into a router at any arbitrary point +# in the router hierarchy even across machines if Object::Remote is involved +# * The tap is used to access a stream of log data and is not used to select +# which packages/modules should be logged +# * For instance Object::Remote 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 tap 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 tap and the logger object +# * Selectors are closures that perform introspection on the log +# message; 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 +# selectors. +# * 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, like warnlogger or log4perl instance +# * selectors - a list of closures; the first one that returns true +# causes the logger to be checked for this log_level and +# invoked if neccassary +# * Register selectors with the destination by invoking a method and specifying +# sub refs as an argument +# +# Technical considerations +# * Log contextual likes to have the logger invoked directly inside the exported log +# specific methods because it removes a need to muck with logger caller depths to +# report back the proper caller information for the logger. +# * Because of this the best strategy identified is to return a list of loggers +# to those exported methods which then invoke the loggers inside the method +# * This means that log message forwarding is a process of querying each parent +# router for a list of logger objects that should be invoked. Each router along +# the hierarchy adds to this list and the log_* method will invoke all loggers +# directly. +# * 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 +# +# +# + + + + diff --git a/lib/Object/Remote/ModuleLoader.pm b/lib/Object/Remote/ModuleLoader.pm index ebd1cb4..a5b8d97 100644 --- a/lib/Object/Remote/ModuleLoader.pm +++ b/lib/Object/Remote/ModuleLoader.pm @@ -3,11 +3,14 @@ package Object::Remote::ModuleLoader; BEGIN { package Object::Remote::ModuleLoader::Hook; use Moo; + use Object::Remote::Logging qw(:log); has sender => (is => 'ro', required => 1); # unqualified INC forced into package main sub Object::Remote::ModuleLoader::Hook::INC { my ($self, $module) = @_; + #TODO not logging - timing issue? + log_debug { "Loading $module via " . ref($self) }; if (my $code = $self->sender->source_for($module)) { open my $fh, '<', \$code; return $fh; @@ -35,12 +38,14 @@ sub _build_inc_hook { sub BUILD { shift->enable } sub enable { + log_debug { "enabling module loader hook" }; push @INC, shift->inc_hook; return; } sub disable { my ($self) = @_; + log_debug { "disabling module loader hook" }; my $hook = $self->inc_hook; @INC = grep $_ ne $hook, @INC; return; diff --git a/lib/Object/Remote/ModuleSender.pm b/lib/Object/Remote/ModuleSender.pm index 6fe0927..ae1f72c 100644 --- a/lib/Object/Remote/ModuleSender.pm +++ b/lib/Object/Remote/ModuleSender.pm @@ -1,5 +1,6 @@ package Object::Remote::ModuleSender; +use Object::Remote::Logging qw( :log :dlog ); use Config; use File::Spec; use List::Util qw(first); @@ -11,22 +12,25 @@ sub _build_dir_list { my %core = map +($_ => 1), grep $_, @Config{ qw(privlibexp archlibexp vendorarchexp sitearchexp) }; - [ grep !$core{$_}, @INC ]; + DlogS_trace { "dir list built in ModuleSender: $_" } [ grep !$core{$_}, @INC ]; } sub source_for { my ($self, $module) = @_; + log_debug { "locating source for module '$module'" }; if (my $find = Object::Remote::FromData->can('find_module')) { if (my $source = $find->($module)) { - return $source; + return Dlog_trace { "Object::Remote::FromData->find_module('$module') returned '$_'" } $source; } } + log_trace { "Searching for module in library directories" }; my ($found) = first { -f $_ } map File::Spec->catfile($_, $module), @{$self->dir_list}; die "Couldn't find ${module} in remote \@INC. dir_list contains:\n" .join("\n", @{$self->dir_list}) unless $found; + log_debug { "found '$module' at '$found'" }; open my $fh, '<', $found or die "Couldn't open ${found} for ${module}: $!"; return do { local $/; <$fh> }; } diff --git a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm index 536897d..d418c23 100644 --- a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm +++ b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm @@ -30,8 +30,8 @@ around connect => sub { return future { $f->on_done(sub { my ($conn) = $f->get; - $conn->remote_sub('Object::Remote::Logging::init_node') - ->(Object::Remote::Logging->arg_router); + my $sub = $conn->remote_sub('Object::Remote::Logging::init_logging_forwarding'); + $sub->('Object::Remote::Logging', Object::Remote::Logging->arg_router); 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 495a9c2..3c1ef62 100644 --- a/lib/Object/Remote/Role/LogForwarder.pm +++ b/lib/Object/Remote/Role/LogForwarder.pm @@ -1,29 +1,51 @@ package Object::Remote::Role::LogForwarder; use Moo::Role; +use Object::Remote::Logging; +use Scalar::Util qw(weaken); +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 child_routers => ( is => 'ro', required => 1, default => sub { [] } ); has parent_router => ( is => 'rw', );#weak_ref => 1 ); -#adds a child router to this router and gives it -#a friendly display name +sub BUILD { } + +after BUILD => sub { + my ($self) = @_; +# my $parent = $self->parent_router; +# return unless defined $parent ; +# $parent->add_child_router($self); +}; + +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); + } + + return $buf; +} + sub add_child_router { - my ($self, $description, $router) = @_; - $self->child_routers->{$description} = $router; - #weaken($self->child_routers->{$class}); - $router->parent_router($self); + my ($self, $router) = @_; + push(@{ $self->child_routers }, $router); +# weaken(${ $self->child_routers }[-1]); return; } -sub remove_child_router { - my ($self, $description) = @_; - return delete $self->child_routers->{$description}; -} +#sub remove_child_router { +# my ($self, $description) = @_; +# return delete $self->child_routers->{$description}; +#} after handle_log_message => sub { my ($self, @args) = @_;