lib/Object/Remote/Logging/Router.pm

   1 package Object::Remote::Logging::Router;
   2
   3 use Moo;
   4
   5 with 'Log::Contextual::Role::Router';
   6 with 'Object::Remote::Role::LogForwarder';
   7
   8 has _controller_package => ( is => 'rwp' );
   9 #lookup table for package names that should not
  10 #be forwarded across Object::Remote connections
  11 has _connections => ( is => 'ro', required => 1, default => sub { [] } );
  12 has _remote_metadata => ( is => 'rw' );
  13
  14 sub before_import {
  15   my ($self, $controller, $importer, $spec) = @_;
  16 }
  17
  18 sub after_import { }
  19
  20 sub _get_loggers {
  21   my ($self, %metadata) = @_;
  22   my $package = $metadata{package};
  23   my $level = $metadata{level};
  24   my $is_level = "is_$level";
  25   my $need_clean = 0;
  26   my @loggers;
  27
  28   foreach my $selector (@{$self->_connections}) {
  29     unless(defined $selector) {
  30       $need_clean = 1;
  31       next;
  32     }
  33
  34     foreach my $logger ($selector->($package, { %metadata })) {
  35       next unless defined $logger;
  36       my $method = $logger->can($is_level);
  37       next unless defined $method;
  38       next unless $logger->$method;
  39       push(@loggers, $logger);
  40     }
  41   }
  42
  43   $self->_clean_connections if $need_clean;
  44
  45   return @loggers;
  46 }
  47
  48 sub handle_log_request {
  49   my ($self, $metadata_in, $generator, @args) = @_;
  50   my %metadata = %{$metadata_in};
  51   my $level = $metadata{level};
  52   my $package = $metadata{package};
  53   my $need_clean = 0;
  54
  55   #caller_level is useless when log forwarding is in place
  56   #so we won't tempt people with using it for now - access
  57   #to caller level will be available in the future
  58   my $caller_level = delete $metadata{caller_level};
  59   $metadata{object_remote} = $self->_remote_metadata;
  60   $metadata{timestamp} = time;
  61
  62   my @caller_info = caller($caller_level);
  63   $metadata{filename} = $caller_info[1];
  64   $metadata{line} = $caller_info[2];
  65
  66   @caller_info = caller($caller_level + 1);
  67   $metadata{method} = $caller_info[3];
  68   $metadata{method} =~ s/^${package}:://;
  69
  70   foreach my $logger ($self->_get_loggers(%metadata)) {
  71     $logger->$level([ $generator->(@args) ], \%metadata);
  72   }
  73 }
  74
  75 sub connect {
  76   my ($self, $destination) = @_;
  77   my $wrapped;
  78
  79   if (ref($destination) ne 'CODE') {
  80     $wrapped = sub { $destination };
  81   } else {
  82     $wrapped = $destination;
  83   }
  84
  85   push(@{$self->_connections}, $wrapped);
  86 }
  87
  88 sub _clean_connections {
  89   my ($self) = @_;
  90   @{$self->{_connections}} = grep { defined } @{$self->{_connections}};
  91 }
  92
  93 1;