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=d99ca44c80464fdd1d332d4308d07c96336dc102;hp=eb336a53065f9ec52a361db8fe517ae563a052c0;hb=29fb87a40b2ebc799be9bee9f400b07c95350fe9;hpb=f4a8508058f7bad5052775a8df3e683527c73333 diff --git a/lib/Object/Remote/Logging.pm b/lib/Object/Remote/Logging.pm index eb336a5..d99ca44 100644 --- a/lib/Object/Remote/Logging.pm +++ b/lib/Object/Remote/Logging.pm @@ -4,10 +4,15 @@ use Moo; use Scalar::Util qw(blessed); use Object::Remote::Logging::Logger; use Exporter::Declare; +use Carp qw(carp croak); extends 'Log::Contextual'; -exports(qw( router )); +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 { @@ -31,18 +36,67 @@ sub arg_levels { return [qw( trace debug verbose info warn error fatal )]; } +sub before_import { + my ($class, $importer, $spec) = @_; + my $router = $class->router; + + $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; + $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 + carp $code->(); + exit($exit_value); + }); + } + } +} + #this is invoked on all nodes sub init_logging { my $level = $ENV{OBJECT_REMOTE_LOG_LEVEL}; + my $format = $ENV{OBJECT_REMOTE_LOG_FORMAT}; + #TODO allow the selections value to be * so it selects everything + my $selections = $ENV{OBJECT_REMOTE_LOG_SELECTIONS}; + my %controller_should_log; + return unless defined $level; + $format = "[%l %r] %s" unless defined $format; + $selections = __PACKAGE__ unless defined $selections; + %controller_should_log = map { $_ => 1 } split(' ', $selections); + my $logger = Object::Remote::Logging::Logger->new( - min_level => lc($level), + min_level => lc($level), format => $format, level_names => Object::Remote::Logging::arg_levels(), ); - #TODO check on speed of string compare against a hash with a single key router()->connect(sub { - return unless $_[1]->{controller} eq __PACKAGE__; + my $controller = $_[1]->{controller}; + return unless $controller_should_log{'*'} || $controller_should_log{$controller}; #skip things from remote hosts because they log to STDERR #when OBJECT_REMOTE_LOG_LEVEL is in effect return if $_[1]->{remote}->{connection_id}; @@ -56,7 +110,7 @@ sub init_logging_forwarding { my ($self, %controller_info) = @_; router()->_remote_metadata({ connection_id => $controller_info{connection_id} }); - router()->_forward_destination($controller_info{router}); + router()->_forward_destination($controller_info{router}) if $ENV{OBJECT_REMOTE_LOG_FORWARDING}; } 1;