X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FObject-Remote.git;a=blobdiff_plain;f=lib%2FObject%2FRemote%2FLogging.pm;h=6e74019d3b17c879fe5c4a0e7d2e7cefca3cf388;hp=49d43f57982ab90bc3c6c526317ee187d614d158;hb=8c3529062a426181861d58ee59fb8f10e0be68e5;hpb=5cd5276e59fc209dbca8f80ec869cf4f2e5e3dff diff --git a/lib/Object/Remote/Logging.pm b/lib/Object/Remote/Logging.pm index 49d43f5..6e74019 100644 --- a/lib/Object/Remote/Logging.pm +++ b/lib/Object/Remote/Logging.pm @@ -9,10 +9,6 @@ use Carp qw(carp croak); extends 'Log::Contextual'; exports(qw( ____ router arg_levels )); -#exception log - log a message then die with that message -export_tag elog => ('____'); -#fatal log - log a message then call exit(1) -export_tag flog => ('____'); sub router { our $Router_Instance ||= do { @@ -39,43 +35,34 @@ sub arg_levels { sub before_import { my ($class, $importer, $spec) = @_; my $router = $class->router; + our $DID_INIT; + unless($DID_INIT) { + $DID_INIT = 1; + init_logging(); + } + $class->SUPER::before_import($importer, $spec); +} - my @levels = @{$class->arg_levels($spec->config->{levels})}; - for my $level (@levels) { - if ($spec->config->{elog}) { - $spec->add_export("&Elog_$level", sub (&) { - my ($code, @args) = @_; - $router->handle_log_request({ - controller => $class, - package => scalar(caller), - caller_level => 1, - level => $level, - }, $code); - #TODO this should get fed into a logger so it can be formatted - croak $code->(); - }); - } - if ($spec->config->{flog}) { - #TODO that prototype isn't right - $spec->add_export("&Flog_$level", sub (&@) { - my ($code, $exit_value) = @_; - $exit_value = 1 unless defined $exit_value; - #don't let it going wrong stop us from calling exit() - eval { $router->handle_log_request({ - controller => $class, - package => scalar(caller), - caller_level => 1, - level => $level, - }, $code) }; - warn "could not deliver log event during Flog_$level: $@" if $@; - eval { carp $code->() }; - warn "could not emit warning during Flog_$level: $@" if $@; - exit($exit_value); - }); - } - } +sub _parse_selections { + my ($selections_string) = @_; + my %log_ok; + + #example string: + #" * -Object::Remote::Logging Foo::Bar::Baz " + foreach(split(/\s+/, $selections_string)) { + next if $_ eq ''; + if ($_ eq '*') { + $log_ok{$_} = 1; + } elsif (s/^-//) { + $log_ok{$_} = 0; + } else { + $log_ok{$_} = 1; + } + } + + return %log_ok; } #this is invoked on all nodes @@ -83,19 +70,35 @@ sub init_logging { my $level = $ENV{OBJECT_REMOTE_LOG_LEVEL}; my $format = $ENV{OBJECT_REMOTE_LOG_FORMAT}; my $selections = $ENV{OBJECT_REMOTE_LOG_SELECTIONS}; + my $test_logging = $ENV{OBJECT_REMOTE_TEST_LOGGER}; my %controller_should_log; + + unless (defined $ENV{OBJECT_REMOTE_LOG_FORWARDING} && $ENV{OBJECT_REMOTE_LOG_FORWARDING} ne '') { + $ENV{OBJECT_REMOTE_LOG_FORWARDING} = 1; + } + + if ($test_logging) { + require Object::Remote::Logging::TestLogger; + router->connect(Object::Remote::Logging::TestLogger->new( + min_level => 'trace', max_level => 'error', + level_names => Object::Remote::Logging->arg_levels(), + )); + } - eval { - require Log::Any::Adapter; - require Object::Remote::Logging::LogAnyInjector; - Log::Any::Adapter->set('+Object::Remote::Logging::LogAnyInjector'); - }; - - return unless defined $level; + return unless defined $level && $level ne ''; $format = "[%l %r] %s" unless defined $format; $selections = __PACKAGE__ unless defined $selections; - %controller_should_log = map { $_ => 1 } split(' ', $selections); - + %controller_should_log = _parse_selections($selections); + + { + no warnings 'once'; + if (defined $Object::Remote::FatNode::REMOTE_NODE) { + #the connection id for the remote node comes in later + #as the controlling node inits remote logging + router()->_remote_metadata({ connection_id => undef }); + } + } + my $logger = Object::Remote::Logging::Logger->new( min_level => lc($level), format => $format, level_names => Object::Remote::Logging::arg_levels(), @@ -103,7 +106,11 @@ sub init_logging { router()->connect(sub { my $controller = $_[1]->{controller}; - return unless $controller_should_log{'*'} || $controller_should_log{$controller}; + my $will_log = $controller_should_log{$controller}; + + $will_log = $controller_should_log{'*'} unless defined $will_log; + + return unless $will_log; #skip things from remote hosts because they log to STDERR #when OBJECT_REMOTE_LOG_LEVEL is in effect return if $_[1]->{remote}->{connection_id}; @@ -113,10 +120,10 @@ sub init_logging { #this is invoked by the controlling node #on the remote nodes -sub init_logging_forwarding { +sub init_remote_logging { my ($self, %controller_info) = @_; - router()->_remote_metadata({ connection_id => $controller_info{connection_id} }); + router()->_remote_metadata(\%controller_info); router()->_forward_destination($controller_info{router}) if $ENV{OBJECT_REMOTE_LOG_FORWARDING}; } @@ -130,7 +137,7 @@ Object::Remote::Logging - Logging subsystem for Object::Remote =head1 SYNOPSIS - use Object::Remote::Logging qw( :log :dlog :elog :flog arg_levels router ); + use Object::Remote::Logging qw( :log :dlog arg_levels router ); @levels = qw( trace debug verbose info warn error fatal ); @levels = arg_levels(); #same result @@ -138,12 +145,11 @@ Object::Remote::Logging - Logging subsystem for Object::Remote $ENV{OBJECT_REMOTE_LOG_LEVEL} = 'trace'; #or other level name $ENV{OBJECT_REMOTE_LOG_FORMAT} = '%l %t: %p::%m %s'; #and more $ENV{OBJECT_REMOTE_LOG_SELECTIONS} = 'Object::Remote::Logging Some::Other::Subclass'; - $ENV{OBJECT_REMOTE_LOG_FORWARDING} = 0 || 1; #default 0 + $ENV{OBJECT_REMOTE_LOG_SELECTIONS} = '* -Object::Remote::Logging'; + $ENV{OBJECT_REMOTE_LOG_FORWARDING} = 0; #default 1 log_info { 'Trace log event' }; Dlog_verbose { "Debug event with Data::Dumper::Concise: $_" } { foo => 'bar' }; - Elog_error { 'Error event that calls die() with this string' }; - Flog_fatal { 'Fatal event calls warn() then exit()' } 1; =head1 DESCRIPTION @@ -180,8 +186,11 @@ automatically be enabled via OBJECT_REMOTE_LOG_LEVEL and formated with OBJECT_REMOTE_LOG_FORMAT but those additional log messages are not sent to STDERR. By setting the OBJECT_REMOTE_LOG_SELECTIONS environment variable to a list of class names seperated by spaces then logs generated by packages that use those classes -will be sent to STDERR. This is also a configuration item that is forwarded to the -remote interpreters so all logging is consistent. +will be sent to STDERR. If the asterisk character (*) is used in the place of a class +name then all class names will be selected by default instead of ignored. An individual +class name can be turned off by prefixing the name with a hypen character (-). This is +also a configuration item that is forwarded to the remote interpreters so all logging +is consistent. Regardless of OBJECT_REMOTE_LOG_LEVEL the logging system is still active and loggers can access the stream of log messages to format and output them. Internally @@ -196,8 +205,8 @@ remote interpreter and the logger for the message is invoked in the local interp Sub-classes of Object::Remote::Logging will have log messages forwarded automatically. Loggers receive forwarded log messages exactly the same way as non-forwarded messages except a forwarded message includes extra metadata about the remote interpreter. Log -forwarding is not currently enabled by default; to enable it set the -OBJECT_REMOTE_LOG_FORWARDING environment variable to 1. See L. +forwarding is enabled by default but comes with a performance hit; to disable it set the +OBJECT_REMOTE_LOG_FORWARDING environment variable to 0. See L. =head1 EXPORTABLE SUBROUTINES @@ -229,27 +238,14 @@ to the block as the argument list and returned from the log method as a list. Works just like log_ and Dlog_ except returns only the first argument as a scalar value. - my $beverage = log_info { "Customer ordered $_[0]" } 'Coffee'; - -=item Elog_ - -Log an event and then generate an exception by calling die() with the log message. - - Elog_error { "Could not open file: $!" }; - -=item Flog_ - -Log the event, generate a warning with the log message, then call exit(). The exit -value will default to 1 or can be specified as an argument. - - Flog_fatal { 'Could not lock resource' } 3; + my $beverage = logS_info { "Customer ordered $_[0]" } 'Coffee'; =back =head1 LEVEL NAMES -Object::Remote uses an ordered list of log level names with the minimum level -first and the maximum level last. The list of level names can be accessed via +Object::Remote uses an ordered list of log level names with the lowest level +first and the highest level last. The list of level names can be accessed via the arg_levels method which is exportable to the consumer of this class. The log level names are: