::Logging::TestLogger package decleration had wrong name

[scpubgit/Object-Remote.git] / lib / Object / Remote / Logging / Logger.pm

diff --git a/lib/Object/Remote/Logging/Logger.pm b/lib/Object/Remote/Logging/Logger.pm
index 5c8295c..e9f1350 100644 (file)
--- a/lib/Object/Remote/Logging/Logger.pm
+++ b/lib/Object/Remote/Logging/Logger.pm
@@ -2,22 +2,54 @@ 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 {
@@ -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;
@@ -69,7 +88,8 @@ sub _create_format_lookup {
   $method = '(none)' unless defined $method;
   
   return { 
-    '%' => '%', t => $self->_render_time($metadata->{timestamp}),
+    '%' => '%', '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,
@@ -92,8 +112,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 {
@@ -153,7 +175,7 @@ Object::Remote::Logging::Logger - Format and output a log message
   
   #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',
   ));
@@ -317,6 +339,10 @@ Process id of the Perl interpreter that generated the log message.
 
 A literal %.
 
+=item %n
+
+A newline.
+
 =back
 
 =back