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     delete $metadata{caller_level};
  59     $metadata{object_remote} = $self->_remote_metadata;
  60
  61     foreach my $logger ($self->_get_loggers(%metadata)) {
  62         $logger->$level([ $generator->(@args) ], \%metadata);
  63     }
  64 }
  65
  66 sub connect {
  67     my ($self, $destination) = @_;
  68     my $wrapped;
  69
  70     if (ref($destination) ne 'CODE') {
  71         $wrapped = sub { $destination };
  72     } else {
  73         $wrapped = $destination;
  74     }
  75
  76     push(@{$self->_connections}, $wrapped);
  77 }
  78
  79 sub _clean_connections {
  80     my ($self) = @_;
  81     @{$self->{_connections}} = grep { defined } @{$self->{_connections}};
  82 }
  83
  84 1;