From: Tyler Riddle <t.riddle@shadowcat.co.uk>
Date: Fri, 14 Sep 2012 00:08:01 +0000 (-0700)
Subject: hierarchical log routing is now implemented in object-remote instead of log-contextual
X-Git-Tag: v0.003001_01~119
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f7ea4120db80a6feb33053e6bcb0f983b71f7394;p=scpubgit%2FObject-Remote.git

hierarchical log routing is now implemented in object-remote instead of log-contextual
---

diff --git a/lib/Object/Remote/LogDestination.pm b/lib/Object/Remote/LogDestination.pm
new file mode 100644
index 0000000..68f4bb3
--- /dev/null
+++ b/lib/Object/Remote/LogDestination.pm
@@ -0,0 +1,21 @@
+package Object::Remote::LogDestination;
+
+use Moo; 
+use Scalar::Util qw(weaken);
+
+has logger => ( is => 'ro', required => 1 );
+has subscriptions => ( is => 'ro', required => 1, default => sub { [] } ); 
+
+sub select {
+   my ($self, $router, $selector) = @_; 
+   my $subscription = $router->subscribe($self->logger, $selector); 
+   push(@{ $self->subscriptions }, $subscription);
+   return $subscription; 
+}
+
+sub connect {
+   my ($self, $router) = @_; 
+   return $self->select($router, sub { 1 });
+}
+
+1; 
\ No newline at end of file
diff --git a/lib/Object/Remote/LogRouter.pm b/lib/Object/Remote/LogRouter.pm
new file mode 100644
index 0000000..2ba0c2c
--- /dev/null
+++ b/lib/Object/Remote/LogRouter.pm
@@ -0,0 +1,107 @@
+package Object::Remote::LogRouter; 
+
+use Moo;
+use Scalar::Util qw(blessed);
+
+with 'Object::Remote::Role::LogForwarder';
+
+has subscriptions => ( is => 'ro', required => 1, default => sub { [] } );
+
+sub before_import { }
+sub after_import {   
+   my ($self, $controller, $importer, $config) = @_;
+   my $logger = $controller->arg_logger($config->{logger});
+   
+# TODO need to review this concept, ignore these configuration values for now
+#   my $package_logger = $controller->arg_package_logger($config->{package_logger});
+#   my $default_logger = $config->{default_logger};
+#      
+#   #when installing a new selector this will be the default
+#   #logger invoked unless otherwise specified
+#   $self->{default_logger} = $default_logger;
+#
+#   #if the logger configuration value is specified 
+#   #then all logs given to the router will also be
+#   #delivered to that logger
+#   if (defined($logger)) {
+#      $self->add_selector(sub { 1 }, $logger); 
+#   }
+#   
+#   #if the configuration specifies a package logger
+#   #build a selector that matches the package and
+#   #install it
+#   if (defined($package_logger)) {
+#      $self->add_selector( sub { $_->{package} eq $importer }, $package_logger );
+#   }
+}
+
+sub subscribe {
+   my ($self, $logger, $selector, $is_temp) = @_; 
+   my $subscription_list = $self->subscriptions;
+   
+   if(ref $logger ne 'CODE') {
+      die 'logger was not a CodeRef or a logger object.  Please try again.'
+         unless blessed($logger);
+      $logger = do { my $l = $logger; sub { $l } }
+   }
+  
+   my $subscription = [ $logger, $selector ];
+  
+   $is_temp = 0 unless defined $is_temp; 
+   push(@$subscription_list, $subscription);
+   if ($is_temp) {
+      #weaken($subscription->[-1]);
+   }
+   return $subscription; 
+}
+
+#TODO turn this logic into a role
+sub handle_log_message {
+   my ($self, $caller, $level, $log_meth, @values) = @_; 
+   my $should_clean = 0; 
+      
+   foreach(@{ $self->subscriptions }) {
+      unless(defined($_)) {
+         $should_clean = 1;
+         next; 
+      }
+      my ($logger, $selector) = @$_;
+      #TODO this is not a firm part of the api but providing
+      #this info to the selector is a good feature
+      local($_) = { level => $level, package => $caller };
+      if ($selector->(@values)) {
+         #TODO resolve caller_level issues with routing
+         #idea: the caller level will differ in distance from the
+         #start of the call stack but it's a constant distance from
+         #the end of the call stack - can that be exploited to calculate
+         #the distance from the start right before it's used?
+         #
+         #newer idea: in order for log4perl to work right the logger
+         #must be invoked in the exported log_* method directly
+         #so by passing the logger down the chain of routers
+         #it can be invoked in that location and the caller level
+         #problem doesn't exist anymore
+         $logger = $logger->($caller, { caller_level => -1 });
+         
+         $logger->$level($log_meth->(@values))
+            if $logger->${\"is_$level"};
+      }
+   }
+   
+   if ($should_clean) {
+      $self->_remove_dead_subscriptions; 
+   }
+   
+   return; 
+}
+
+sub _remove_dead_subscriptions {
+   my ($self) = @_; 
+   my @ok = grep { defined $_ } @{$self->subscriptions}; 
+   @{$self->subscriptions} = @ok; 
+   return; 
+}
+
+
+1; 
+
diff --git a/lib/Object/Remote/Logging.pm b/lib/Object/Remote/Logging.pm
index 1839f22..25831ac 100644
--- a/lib/Object/Remote/Logging.pm
+++ b/lib/Object/Remote/Logging.pm
@@ -2,14 +2,14 @@ package Object::Remote::Logging;
 
 use strictures 1;
 
-use Log::Contextual::Routed qw( :log );
-use base qw(Log::Contextual::Routed); 
+use Log::Contextual qw( :log );
+use Object::Remote::LogRouter;
 
-sub get_parent_router { $_[0]->SUPER::get_parent_router }
+use base qw(Log::Contextual); 
 
-use Data::Dumper; 
+sub arg_router { return $_[1] if defined $_[1]; our $Router_Instance ||= Object::Remote::LogRouter->new }
 
-sub init_node { my $n = `hostname`; chomp($n); $_[0]->add_child_router("[node $n]", __PACKAGE__->get_root_router) }
+sub init_node { my $n = `hostname`; chomp($n); $_[0]->add_child_router("[node $n]", __PACKAGE__->arg_router) }
 
 1;
 
diff --git a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm
index e041cc1..536897d 100644
--- a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm
+++ b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm
@@ -31,7 +31,7 @@ around connect => sub {
     $f->on_done(sub {
       my ($conn) = $f->get;
       $conn->remote_sub('Object::Remote::Logging::init_node')
-         ->(Object::Remote::Logging->get_router);
+         ->(Object::Remote::Logging->arg_router);
       Object::Remote::Handle->new(
         connection => $conn,
         class => 'Object::Remote::ModuleLoader',
diff --git a/lib/Object/Remote/Role/LogForwarder.pm b/lib/Object/Remote/Role/LogForwarder.pm
new file mode 100644
index 0000000..495a9c2
--- /dev/null
+++ b/lib/Object/Remote/Role/LogForwarder.pm
@@ -0,0 +1,36 @@
+package Object::Remote::Role::LogForwarder;
+
+use Moo::Role; 
+
+with 'Log::Contextual::Role::Router';
+
+#TODO re-weaken router references when object::remote
+#weak reference operation is figured out
+
+has child_routers => ( is => 'ro', required => 1, default => sub { {} } );
+has parent_router => ( is => 'rw', );#weak_ref => 1 );
+
+#adds a child router to this router and gives it
+#a friendly display name
+sub add_child_router {
+   my ($self, $description, $router) = @_;
+   $self->child_routers->{$description} = $router;
+   #weaken($self->child_routers->{$class});
+   $router->parent_router($self);
+   return; 
+}
+
+sub remove_child_router {
+   my ($self, $description) = @_;
+   return delete $self->child_routers->{$description};
+}
+
+after handle_log_message => sub {
+   my ($self, @args) = @_;
+   my $parent = $self->parent_router;
+      
+   return unless defined $parent;
+   $parent->handle_log_message(@args);
+};
+
+1;