From: Tyler Riddle <t.riddle@shadowcat.co.uk>
Date: Fri, 9 Nov 2012 16:00:35 +0000 (-0800)
Subject: logger class now supports instances with distinct log levels via autoload methods
X-Git-Tag: v0.003001_01~75
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f21127fd8c611eee83f769422168bb7bf3b25f0a;p=scpubgit%2FObject-Remote.git

logger class now supports instances with distinct log levels via autoload methods
---

diff --git a/lib/Object/Remote/Logging.pm b/lib/Object/Remote/Logging.pm
index e049769..7e030ff 100644
--- a/lib/Object/Remote/Logging.pm
+++ b/lib/Object/Remote/Logging.pm
@@ -169,20 +169,20 @@ environment variable on the local interpreter will cause it to be propagated to
 remote interpreter so all logs will be formated the same way.
 
 This class is designed so any module can create their own logging sub-class using it.
-With out any additional configuration consumers of this logging class will 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.
+With out any additional configuration the consumers of this logging class will
+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.
 
 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
 OBJECT_REMOTE_LOG_LEVEL causes an L<Object::Remote::Logging::Logger> to be built
 and connected to the L<Object::Remote::Logging::Router> instance. It is also possible
 to manually build a logger instance and connect it to the router. See the documentation
-for the router and logger class.
+for the logger and router classes.
 
 The logging system also supports a method of forwarding log messages from remote
 interpreters to the local interpreter. Forwarded log messages are generated in the
diff --git a/lib/Object/Remote/Logging/Logger.pm b/lib/Object/Remote/Logging/Logger.pm
index 5c8295c..65b42b9 100644
--- a/lib/Object/Remote/Logging/Logger.pm
+++ b/lib/Object/Remote/Logging/Logger.pm
@@ -2,17 +2,49 @@ package Object::Remote::Logging::Logger;
 
 use Moo;
 use Scalar::Util qw(weaken);
+use Carp qw(croak);
 
+#TODO sigh invoking a logger with a log level name the same
+#as an attribute could happen - restrict attributes to _ prefix
+#and restrict log levels to not start with out that prefix?
 has format => ( is => 'ro', required => 1, default => sub { '%l: %s' } );
 has level_names => ( is => 'ro', required => 1 );
-has min_level => ( is => 'ro', required => 1, default => 'info' );
+has min_level => ( is => 'ro', required => 1, default => sub { 'info' } );
 has max_level => ( is => 'lazy', required => 1 );
 has _level_active => ( is => 'lazy' );
 
-sub BUILD {
-  my ($self) = @_;
-  our $METHODS_INSTALLED; 
-  $self->_install_methods unless $METHODS_INSTALLED;
+#just a stub so it doesn't get to AUTOLOAD
+sub BUILD { }
+sub DESTROY { }
+
+sub AUTOLOAD {
+  my $self = shift;
+  (my $method) = (our $AUTOLOAD =~ /([^:]+)$/);
+
+  no strict 'refs';
+
+  if ($method =~ m/^_/) {
+    croak "invalid method name $method for " . ref($self);
+  }
+
+  if ($method =~ m/^is_(.+)/) {
+    my $level_name = $1;
+    my $is_method = "is_$level_name";
+    *{$is_method} = sub { shift(@_)->_level_active->{$level_name} };
+    return $self->$is_method;
+  }
+
+  my $level_name = $method;
+  *{$level_name} = sub {
+    my $self = shift;
+    unless(exists($self->_level_active->{$level_name})) {
+      croak "$level_name is not a valid log level name";
+    }
+
+    $self->_log($level_name, @_);
+  };
+  
+  return $self->$level_name(@_);
 }
 
 sub _build_max_level {
@@ -42,19 +74,6 @@ sub _build__level_active {
   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) = @_;
   my %metadata = %$metadata_in;
diff --git a/lib/Object/Remote/Logging/Router.pm b/lib/Object/Remote/Logging/Router.pm
index 2d48ca5..7479dd7 100644
--- a/lib/Object/Remote/Logging/Router.pm
+++ b/lib/Object/Remote/Logging/Router.pm
@@ -35,9 +35,9 @@ sub _get_loggers {
 
     foreach my $logger ($selector->($package, { %metadata })) {
       next unless defined $logger;
-      my $method = $logger->can($is_level);
-      next unless defined $method;
-      next unless $logger->$method;
+      #my $method = $logger->can($is_level);
+      #next unless defined $method;
+      next unless $logger->$is_level;
       push(@loggers, $logger);
     }
   }