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