Commit | Line | Data |
5e2b2229 |
1 | package Object::Remote::Logging; |
2 | |
4e446335 |
3 | use Moo; |
4 | use Scalar::Util qw(blessed); |
5 | use Object::Remote::Logging::Logger; |
f4a85080 |
6 | use Exporter::Declare; |
663fb34f |
7 | use Carp qw(carp croak); |
5e2b2229 |
8 | |
4e446335 |
9 | extends 'Log::Contextual'; |
5e2b2229 |
10 | |
663fb34f |
11 | exports(qw( ____ router arg_levels )); |
12 | #exception log - log a message then die with that message |
13 | export_tag elog => ('____'); |
14 | #fatal log - log a message then call exit(1) |
15 | export_tag flog => ('____'); |
f4a85080 |
16 | |
4e446335 |
17 | sub router { |
c0b2df05 |
18 | our $Router_Instance ||= do { |
19 | require Object::Remote::Logging::Router; |
20 | Object::Remote::Logging::Router->new; |
21 | } |
4e446335 |
22 | } |
5e2b2229 |
23 | |
9de32e1d |
24 | #log level descriptions |
25 | #info - standard log level - normal program output for the end user |
26 | #warn - output for program that is executing quietly |
27 | #error - output for program that is running more quietly |
28 | #fatal - it is not possible to continue execution; this level is as quiet as is possible |
29 | #verbose - output for program executing verbosely (-v) |
30 | #debug - output for program running more verbosely (-v -v) |
31 | #trace - output for program running extremely verbosely (-v -v -v) |
4e446335 |
32 | sub arg_levels { |
9de32e1d |
33 | #the order of the log levels is significant with the |
34 | #most verbose level being first in the list and the |
35 | #most quiet as the last item |
36 | return [qw( trace debug verbose info warn error fatal )]; |
4a9fa1a5 |
37 | } |
5e2b2229 |
38 | |
663fb34f |
39 | sub before_import { |
40 | my ($class, $importer, $spec) = @_; |
41 | my $router = $class->router; |
42 | |
43 | $class->SUPER::before_import($importer, $spec); |
44 | |
45 | my @levels = @{$class->arg_levels($spec->config->{levels})}; |
46 | for my $level (@levels) { |
47 | if ($spec->config->{elog}) { |
48 | $spec->add_export("&Elog_$level", sub (&) { |
49 | my ($code, @args) = @_; |
50 | $router->handle_log_request({ |
51 | controller => $class, |
52 | package => scalar(caller), |
53 | caller_level => 1, |
54 | level => $level, |
55 | }, $code); |
56 | #TODO this should get fed into a logger so it can be formatted |
57 | croak $code->(); |
58 | }); |
59 | } |
60 | if ($spec->config->{flog}) { |
61 | #TODO that prototype isn't right |
62 | $spec->add_export("&Flog_$level", sub (&@) { |
63 | my ($code, $exit_value) = @_; |
64 | $exit_value = 1 unless defined $exit_value; |
65 | $router->handle_log_request({ |
66 | controller => $class, |
67 | package => scalar(caller), |
68 | caller_level => 1, |
69 | level => $level, |
70 | }, $code); |
71 | #TODO this should get fed into a logger so it can be formatted |
72 | carp $code->(); |
73 | exit($exit_value); |
74 | }); |
75 | } |
76 | } |
77 | } |
78 | |
4e446335 |
79 | #this is invoked on all nodes |
4a9fa1a5 |
80 | sub init_logging { |
c0b2df05 |
81 | my $level = $ENV{OBJECT_REMOTE_LOG_LEVEL}; |
0fe333eb |
82 | my $format = $ENV{OBJECT_REMOTE_LOG_FORMAT}; |
eb49c7df |
83 | #TODO allow the selections value to be * so it selects everything |
84 | my $selections = $ENV{OBJECT_REMOTE_LOG_SELECTIONS}; |
85 | my %controller_should_log; |
86 | |
c0b2df05 |
87 | return unless defined $level; |
0fe333eb |
88 | $format = "[%l %r] %s" unless defined $format; |
eb49c7df |
89 | $selections = __PACKAGE__ unless defined $selections; |
90 | %controller_should_log = map { $_ => 1 } split(' ', $selections); |
91 | |
c0b2df05 |
92 | my $logger = Object::Remote::Logging::Logger->new( |
0fe333eb |
93 | min_level => lc($level), format => $format, |
c0b2df05 |
94 | level_names => Object::Remote::Logging::arg_levels(), |
95 | ); |
96 | |
c0b2df05 |
97 | router()->connect(sub { |
eb49c7df |
98 | my $controller = $_[1]->{controller}; |
466ee2c4 |
99 | return unless $controller_should_log{'*'} || $controller_should_log{$controller}; |
c0b2df05 |
100 | #skip things from remote hosts because they log to STDERR |
101 | #when OBJECT_REMOTE_LOG_LEVEL is in effect |
102 | return if $_[1]->{remote}->{connection_id}; |
103 | $logger |
104 | }); |
4a9fa1a5 |
105 | } |
106 | |
4e446335 |
107 | #this is invoked by the controlling node |
108 | #on the remote nodes |
4a9fa1a5 |
109 | sub init_logging_forwarding { |
4e446335 |
110 | my ($self, %controller_info) = @_; |
111 | |
112 | router()->_remote_metadata({ connection_id => $controller_info{connection_id} }); |
466ee2c4 |
113 | router()->_forward_destination($controller_info{router}) if $ENV{OBJECT_REMOTE_LOG_FORWARDING}; |
4a9fa1a5 |
114 | } |
5e2b2229 |
115 | |
116 | 1; |
117 | |