lib/Object/Remote/LogRouter.pm

   1 package Object::Remote::LogRouter;
   2
   3 use Moo;
   4 use Scalar::Util qw(blessed);
   5
   6 with 'Object::Remote::Role::LogForwarder';
   7
   8 has subscriptions => ( is => 'ro', required => 1, default => sub { [] } );
   9
  10 sub before_import { }
  11 sub after_import {
  12    my ($self, $controller, $importer, $config) = @_;
  13    my $logger = $controller->arg_logger($config->{logger});
  14
  15 # TODO need to review this concept, ignore these configuration values for now
  16 #   my $package_logger = $controller->arg_package_logger($config->{package_logger});
  17 #   my $default_logger = $config->{default_logger};
  18 #
  19 #   #when installing a new selector this will be the default
  20 #   #logger invoked unless otherwise specified
  21 #   $self->{default_logger} = $default_logger;
  22 #
  23 #   #if the logger configuration value is specified
  24 #   #then all logs given to the router will also be
  25 #   #delivered to that logger
  26 #   if (defined($logger)) {
  27 #      $self->add_selector(sub { 1 }, $logger);
  28 #   }
  29 #
  30 #   #if the configuration specifies a package logger
  31 #   #build a selector that matches the package and
  32 #   #install it
  33 #   if (defined($package_logger)) {
  34 #      $self->add_selector( sub { $_->{package} eq $importer }, $package_logger );
  35 #   }
  36 }
  37
  38 sub subscribe {
  39    my ($self, $logger, $selector, $is_temp) = @_;
  40    my $subscription_list = $self->subscriptions;
  41
  42    if(ref $logger ne 'CODE') {
  43       die 'logger was not a CodeRef or a logger object.  Please try again.'
  44          unless blessed($logger);
  45       $logger = do { my $l = $logger; sub { $l } }
  46    }
  47
  48    my $subscription = [ $logger, $selector ];
  49
  50    $is_temp = 0 unless defined $is_temp;
  51    push(@$subscription_list, $subscription);
  52    if ($is_temp) {
  53       #weaken($subscription->[-1]);
  54    }
  55    return $subscription;
  56 }
  57
  58 #TODO turn this logic into a role
  59 sub handle_log_message {
  60    my ($self, $caller, $level, $log_meth, @values) = @_;
  61    my $should_clean = 0;
  62
  63    foreach(@{ $self->subscriptions }) {
  64       unless(defined($_)) {
  65          $should_clean = 1;
  66          next;
  67       }
  68       my ($logger, $selector) = @$_;
  69       #TODO this is not a firm part of the api but providing
  70       #this info to the selector is a good feature
  71       local($_) = { level => $level, package => $caller };
  72       if ($selector->(@values)) {
  73          #TODO resolve caller_level issues with routing
  74          #idea: the caller level will differ in distance from the
  75          #start of the call stack but it's a constant distance from
  76          #the end of the call stack - can that be exploited to calculate
  77          #the distance from the start right before it's used?
  78          #
  79          #newer idea: in order for log4perl to work right the logger
  80          #must be invoked in the exported log_* method directly
  81          #so by passing the logger down the chain of routers
  82          #it can be invoked in that location and the caller level
  83          #problem doesn't exist anymore
  84          $logger = $logger->($caller, { caller_level => -1 });
  85
  86          $logger->$level($log_meth->(@values))
  87             if $logger->${\"is_$level"};
  88       }
  89    }
  90
  91    if ($should_clean) {
  92       $self->_remove_dead_subscriptions;
  93    }
  94
  95    return;
  96 }
  97
  98 sub _remove_dead_subscriptions {
  99    my ($self) = @_;
 100    my @ok = grep { defined $_ } @{$self->subscriptions};
 101    @{$self->subscriptions} = @ok;
 102    return;
 103 }
 104
 105
 106 1;
 107