X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FObject%2FRemote%2FLogging.pm;h=45a41de51dcc668f05b88dada067c8fc437af18a;hb=998ff9a49b1f18c9ec82212eda094c8261c0ef1c;hp=7e030ff49a5c8108d278ee89431e0a2876ed6cc1;hpb=f21127fd8c611eee83f769422168bb7bf3b25f0a;p=scpubgit%2FObject-Remote.git

diff --git a/lib/Object/Remote/Logging.pm b/lib/Object/Remote/Logging.pm
index 7e030ff..45a41de 100644
--- a/lib/Object/Remote/Logging.pm
+++ b/lib/Object/Remote/Logging.pm
@@ -39,7 +39,13 @@ 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})};
@@ -69,27 +75,56 @@ sub before_import {
                caller_level => 1,
                level => $level,
             }, $code) };
-            warn "could not deliver log event during Flog_$level: $@" if defined $@;
+            warn "could not deliver log event during Flog_$level: $@" if $@;
             eval { carp $code->() };
-            warn "could not emit warning during Flog_$level: $@" if defined $@;
+            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
 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 %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);
-  
+  %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(),
@@ -97,7 +132,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};
@@ -107,10 +146,13 @@ 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);
+  #TODO having an instance of an object in the remote interpreter causes it to hang
+  #on exit intermitently or leave a zombie laying around frequently - not a bug limited
+  #to log forwarding
   router()->_forward_destination($controller_info{router}) if $ENV{OBJECT_REMOTE_LOG_FORWARDING};
 }
 
@@ -132,6 +174,7 @@ 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_SELECTIONS} = '* -Object::Remote::Logging';
   $ENV{OBJECT_REMOTE_LOG_FORWARDING} = 0 || 1; #default 0
   
   log_info { 'Trace log event' };
@@ -174,8 +217,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
@@ -242,8 +288,8 @@ value will default to 1 or can be specified as an argument.
 
 =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: