X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FObject-Remote.git;a=blobdiff_plain;f=lib%2FObject%2FRemote%2FLogging%2FLogger.pm;h=5d940a1ed74c84c0da4887211b1c0fb3ae74eeaa;hp=5c8295c4632a3779709ae585d76665f41e5785fb;hb=4cef6a48c7132caae25207eed7a2105204ef6e61;hpb=455d031ccaa22069757d53cac1e90fda622b80d0

diff --git a/lib/Object/Remote/Logging/Logger.pm b/lib/Object/Remote/Logging/Logger.pm
index 5c8295c..5d940a1 100644
--- a/lib/Object/Remote/Logging/Logger.pm
+++ b/lib/Object/Remote/Logging/Logger.pm
@@ -1,39 +1,70 @@
 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 {
-    my ($self) = @_;
-    return $self->level_names->[-1];
+  my ($self) = @_;
+  return $self->level_names->[-1];
 }
 
 sub _build__level_active {
-  my ($self) = @_; 
+  my ($self) = @_;
   my $should_log = 0;
   my $min_level = $self->min_level;
   my $max_level = $self->max_level;
   my %active;
-    
+
   foreach my $level (@{$self->level_names}) {
     if($level eq $min_level) {
-      $should_log = 1; 
+      $should_log = 1;
     }
 
     $active{$level} = $should_log;
-        
+
     if (defined $max_level && $level eq $max_level) {
       $should_log = 0;
     }
@@ -42,19 +73,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;
@@ -65,15 +83,16 @@ sub _log {
 sub _create_format_lookup {
   my ($self, $level, $metadata, $content) = @_;
   my $method = $metadata->{method};
-  
+
   $method = '(none)' unless defined $method;
-  
-  return { 
-    '%' => '%', t => $self->_render_time($metadata->{timestamp}),
+
+  return {
+    '%' => '%', 'n' => "\n",
+    t => $self->_render_time($metadata->{timestamp}),
     r => $self->_render_remote($metadata->{object_remote}),
-    s => $self->_render_log(@$content), l => $level, 
-    c => $metadata->{controller}, p => $metadata->{package}, m => $method,
-    f => $metadata->{filename}, i => $metadata->{line}, 
+    s => $self->_render_log(@$content), l => $level,
+    c => $metadata->{exporter}, p => $metadata->{caller_package}, m => $method,
+    f => $metadata->{filename}, i => $metadata->{line},
     h => $metadata->{hostname}, P => $metadata->{pid},
   };
 }
@@ -92,8 +111,10 @@ sub _render_time {
 
 sub _render_remote {
   my ($self, $remote) = @_;
-  return 'local' if ! defined $remote || ! defined $remote->{connection_id};
-  return 'remote #' . $remote->{connection_id};
+  return 'local' unless defined $remote;
+  my $conn_id = $remote->{connection_id};
+  $conn_id = '(uninit)' unless defined $conn_id;
+  return "remote #$conn_id";
 }
 
 sub _render_log {
@@ -104,9 +125,9 @@ sub _render {
   my ($self, $level, $metadata, @content) = @_;
   my $var_table = $self->_create_format_lookup($level, $metadata, [@content]);
   my $template = $self->format;
-  
+
   $template =~ s/%([\w%])/$self->_get_format_var_value($1, $var_table)/ge;
-  
+
   chomp($template);
   $template =~ s/\n/\n /g;
   $template .= "\n";
@@ -130,7 +151,7 @@ Object::Remote::Logging::Logger - Format and output a log message
 
   use Object::Remote::Logging::Logger;
   use Object::Remote::Logging qw( router arg_levels );
-  
+
   my $app_output = Object::Remote::Logging::Logger->new(
     level_names => arg_levels, format => '%t %s',
     min_level => 'verbose', max_level => 'info',
@@ -140,7 +161,7 @@ Object::Remote::Logging::Logger - Format and output a log message
   #objects that will receive the messages
   my $selector = sub {
     my ($generating_package, $metadata) = @_;
-    return unless $metadata->{controller} eq 'App::Logging::Subclass';
+    return unless $metadata->{exporter} eq 'App::Logging::Subclass';
     return $app_output;
   };
 
@@ -150,17 +171,17 @@ Object::Remote::Logging::Logger - Format and output a log message
 
   #disconnect the selector from the router
   undef($selector);
-  
+
   #router will hold this logger forever
   #and send it all log messages
-  router->connect(Object::Remote::Logging::WarnLogger->new(
+  router->connect(Object::Remote::Logging::Logger->new(
     level_names => arg_levels, format => '%s at %f line %i, log level: %l'
     min_level => 'warn', max_level => 'error',
   ));
 
 =head1 DESCRIPTION
 
-This class receives log messages from an instance of L<Object::Remote::Log::Router>,
+This class receives log messages from an instance of L<Object::Remote::Logging::Router>,
 formats them according to configuration, and then outputs them to STDERR. In between
 the router and the logger is a selector method which inspects the log message metadata
 and can return 0 or more loggers that should receive the log message.
@@ -170,14 +191,14 @@ and can return 0 or more loggers that should receive the log message.
 A logger object receives the log messages that are generated and converts them to
 formatted log entries then displays them to the end user. Each logger has a set
 of active log levels and will only output a log entry if the log message is at
-an active log level. 
+an active log level.
 
 To gain access to the stream of log messages a connection is made to the log router.
 A logger can directly connect to the router and receive an unfiltered stream of
 log messages or a selector closure can be used instead. The selector will be executed
 for each log message with the message metadata and returns a list of 0 or more loggers
 that should receive the log message. When the selector is executed the first argument
-is the class name of the package that generated the log message and the second argument
+is the name of the package that generated the log message and the second argument
 is a hash reference containing the message metadata.
 
 =head1 METADATA
@@ -186,16 +207,15 @@ The message metadata is a hash reference with the following keys:
 
 =over 4
 
-=item level
+=item message_level
 
 Name of the log level of the message.
 
-=item controller
+=item exporter
 
-Name of the sub-class of Object::Remote::Logging in use by
-the generating package.
+Package name of the logging API that was used to generate the log message.
 
-=item package
+=item caller_package
 
 Name of the package that generated the log message.
 
@@ -246,7 +266,7 @@ Object::Remote::Connection id of that interpreter will be available here.
 =item level_names
 
 This is a required attribute. Must be an array ref with the list of log level names
-in it. The list must be ordered with the lowest level as element 0 and the highest 
+in it. The list must be ordered with the lowest level as element 0 and the highest
 level as the last element. There is no default value.
 
 =item min_level
@@ -271,7 +291,7 @@ Level name that the log message was generated at.
 
 =item %s
 
-Log message rendered into a string with a leading space before any additional lines in a 
+Log message rendered into a string with a leading space before any additional lines in a
 multiple line message.
 
 =item %t
@@ -282,16 +302,15 @@ received the log message on the local interpreter if the log message was forward
 
 =item %r
 
-Log::Remote connection information rendered into a string.
+Object::Remote connection information rendered into a string.
 
 =item %c
 
-Name of the sub-class of Object::Remote::Logging that was used by the class
-that generated the log message. Can also be Object::Remote::Logging itself.
+Package name of the logging API that was used to generate the log message.
 
 =item %p
 
-Package name of the class that generated the log message.
+Name of the package that generated the log message.
 
 =item %m
 
@@ -317,6 +336,10 @@ Process id of the Perl interpreter that generated the log message.
 
 A literal %.
 
+=item %n
+
+A newline.
+
 =back
 
 =back