1 package Object::Remote::LogRouter;
4 use Scalar::Util qw(blessed);
6 with 'Object::Remote::Role::LogForwarder';
8 has subscriptions => ( is => 'ro', required => 1, default => sub { [] } );
12 my ($self, $controller, $importer, $config) = @_;
13 my $logger = $controller->arg_logger($config->{logger});
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};
19 # #when installing a new selector this will be the default
20 # #logger invoked unless otherwise specified
21 # $self->{default_logger} = $default_logger;
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);
30 # #if the configuration specifies a package logger
31 # #build a selector that matches the package and
33 # if (defined($package_logger)) {
34 # $self->add_selector( sub { $_->{package} eq $importer }, $package_logger );
39 my ($self, $logger, $selector, $is_temp) = @_;
40 my $subscription_list = $self->subscriptions;
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 } }
48 my $subscription = [ $logger, $selector ];
50 $is_temp = 0 unless defined $is_temp;
51 push(@$subscription_list, $subscription);
53 #weaken($subscription->[-1]);
58 #TODO turn this logic into a role
59 sub handle_log_message {
60 my ($self, $caller, $level, $log_meth, @values) = @_;
63 foreach(@{ $self->subscriptions }) {
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?
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 });
86 $logger->$level($log_meth->(@values))
87 if $logger->${\"is_$level"};
92 $self->_remove_dead_subscriptions;
98 sub _remove_dead_subscriptions {
100 my @ok = grep { defined $_ } @{$self->subscriptions};
101 @{$self->subscriptions} = @ok;