Commit | Line | Data |
4e446335 |
1 | package Object::Remote::Logging::Logger; |
2 | |
3 | use Moo; |
4 | use Scalar::Util qw(weaken); |
5 | |
0fe333eb |
6 | has format => ( is => 'ro', required => 1, default => sub { '%l: %s' } ); |
4e446335 |
7 | has level_names => ( is => 'ro', required => 1 ); |
8 | has min_level => ( is => 'ro', required => 1 ); |
fe203cb2 |
9 | has max_level => ( is => 'ro', required => 1, deafult => sub { 'info' } ); |
4e446335 |
10 | has _level_active => ( is => 'lazy' ); |
11 | |
12 | sub BUILD { |
c0b2df05 |
13 | my ($self) = @_; |
14 | our $METHODS_INSTALLED; |
15 | $self->_install_methods unless $METHODS_INSTALLED; |
4e446335 |
16 | } |
17 | |
18 | sub _build__level_active { |
c0b2df05 |
19 | my ($self) = @_; |
20 | my $should_log = 0; |
21 | my $min_level = $self->min_level; |
22 | my $max_level = $self->max_level; |
23 | my %active; |
4e446335 |
24 | |
c0b2df05 |
25 | foreach my $level (@{$self->level_names}) { |
26 | if($level eq $min_level) { |
27 | $should_log = 1; |
28 | } |
29 | |
30 | $active{$level} = $should_log; |
4e446335 |
31 | |
c0b2df05 |
32 | if (defined $max_level && $level eq $max_level) { |
33 | $should_log = 0; |
4e446335 |
34 | } |
c0b2df05 |
35 | } |
36 | |
37 | return \%active; |
4e446335 |
38 | } |
39 | |
40 | sub _install_methods { |
c0b2df05 |
41 | my ($self) = @_; |
42 | my $should_log = 0; |
43 | our $METHODS_INSTALLED = 1; |
454ec6a2 |
44 | |
c0b2df05 |
45 | no strict 'refs'; |
454ec6a2 |
46 | |
c0b2df05 |
47 | foreach my $level (@{$self->level_names}) { |
48 | *{"is_$level"} = sub { shift(@_)->_level_active->{$level} }; |
49 | *{$level} = sub { shift(@_)->_log($level, @_) }; |
50 | } |
4e446335 |
51 | } |
52 | |
53 | sub _log { |
c0b2df05 |
54 | my ($self, $level, $content, $metadata_in) = @_; |
c0b2df05 |
55 | my %metadata = %$metadata_in; |
56 | my $rendered = $self->_render($level, \%metadata, @$content); |
57 | $self->_output($rendered); |
4e446335 |
58 | } |
59 | |
454ec6a2 |
60 | sub _create_format_lookup { |
61 | my ($self, $level, $metadata, $content) = @_; |
b43174a1 |
62 | my $method = $metadata->{method}; |
63 | |
64 | $method = '(none)' unless defined $method; |
65 | |
454ec6a2 |
66 | return { |
67 | '%' => '%', t => $self->_render_time($metadata->{timestamp}), |
68 | r => $self->_render_remote($metadata->{object_remote}), |
238812ba |
69 | s => $self->_render_log(@$content), l => $level, |
eb49c7df |
70 | c => $metadata->{controller}, p => $metadata->{package}, m => $method, |
466ee2c4 |
71 | f => $metadata->{filename}, i => $metadata->{line}, |
72 | h => $metadata->{hostname}, P => $metadata->{pid}, |
454ec6a2 |
73 | |
74 | }; |
75 | } |
76 | |
77 | sub _get_format_var_value { |
78 | my ($self, $name, $data) = @_; |
79 | my $val = $data->{$name}; |
80 | return $val if defined $val; |
466ee2c4 |
81 | return '(undefined)'; |
454ec6a2 |
82 | } |
83 | |
84 | sub _render_time { |
85 | my ($self, $time) = @_; |
86 | return scalar(localtime($time)); |
87 | } |
88 | |
89 | sub _render_remote { |
90 | my ($self, $remote) = @_; |
91 | return 'local' if ! defined $remote || ! defined $remote->{connection_id}; |
92 | return 'remote #' . $remote->{connection_id}; |
93 | } |
94 | |
95 | sub _render_log { |
96 | my ($self, @content) = @_; |
97 | return join('', @content); |
98 | } |
4e446335 |
99 | sub _render { |
c0b2df05 |
100 | my ($self, $level, $metadata, @content) = @_; |
454ec6a2 |
101 | my $var_table = $self->_create_format_lookup($level, $metadata, [@content]); |
102 | my $template = $self->format; |
f4a85080 |
103 | |
466ee2c4 |
104 | $template =~ s/%([\w%])/$self->_get_format_var_value($1, $var_table)/ge; |
f4a85080 |
105 | |
454ec6a2 |
106 | chomp($template); |
107 | $template =~ s/\n/\n /g; |
108 | $template .= "\n"; |
109 | return $template; |
4e446335 |
110 | } |
111 | |
112 | sub _output { |
c0b2df05 |
113 | my ($self, $content) = @_; |
114 | print STDERR $content; |
4e446335 |
115 | } |
116 | |
117 | |
118 | 1; |
119 | |