line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Log::Log4perl::Layout::JSON; |
2
|
|
|
|
|
|
|
$Log::Log4perl::Layout::JSON::VERSION = '0.58'; |
3
|
|
|
|
|
|
|
# ABSTRACT: Layout a log message as a JSON hash, including MDC data |
4
|
|
|
|
|
|
|
|
5
|
7
|
|
|
7
|
|
27867
|
use 5.010; |
|
7
|
|
|
|
|
30
|
|
6
|
7
|
|
|
7
|
|
44
|
use strict; |
|
7
|
|
|
|
|
16
|
|
|
7
|
|
|
|
|
169
|
|
7
|
7
|
|
|
7
|
|
39
|
use warnings; |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
247
|
|
8
|
|
|
|
|
|
|
|
9
|
7
|
|
|
7
|
|
1048
|
use parent qw(Log::Log4perl::Layout); |
|
7
|
|
|
|
|
695
|
|
|
7
|
|
|
|
|
51
|
|
10
|
|
|
|
|
|
|
|
11
|
7
|
|
|
7
|
|
605
|
use Carp; |
|
7
|
|
|
|
|
21
|
|
|
7
|
|
|
|
|
563
|
|
12
|
7
|
|
|
7
|
|
49
|
use JSON::MaybeXS; |
|
7
|
|
|
|
|
15
|
|
|
7
|
|
|
|
|
437
|
|
13
|
7
|
|
|
7
|
|
48
|
use Log::Log4perl (); |
|
7
|
|
|
|
|
16
|
|
|
7
|
|
|
|
|
130
|
|
14
|
7
|
|
|
7
|
|
38
|
use Log::Log4perl::Layout::PatternLayout; |
|
7
|
|
|
|
|
17
|
|
|
7
|
|
|
|
|
220
|
|
15
|
7
|
|
|
7
|
|
43
|
use Log::Log4perl::Level; |
|
7
|
|
|
|
|
20
|
|
|
7
|
|
|
|
|
58
|
|
16
|
7
|
|
|
7
|
|
1326
|
use Scalar::Util qw(blessed); |
|
7
|
|
|
|
|
26
|
|
|
7
|
|
|
|
|
2986
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# TODO |
19
|
|
|
|
|
|
|
# add eval around encode |
20
|
|
|
|
|
|
|
# add way to include/exclude MDC items when include_mdc is enabled (eg by name and perhaps allow a regex) |
21
|
|
|
|
|
|
|
# more tests |
22
|
|
|
|
|
|
|
# consider ways to limit depth/breadth of encoded mdc data |
23
|
|
|
|
|
|
|
# add overall message size limit |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
use Class::Tiny { |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
prefix => "", |
28
|
|
|
|
|
|
|
format_prefix => 0, |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
codec => sub { |
31
|
18
|
|
|
|
|
322
|
return JSON::MaybeXS->new |
32
|
|
|
|
|
|
|
->indent(0) # to prevent newlines (and save space) |
33
|
|
|
|
|
|
|
->ascii(1) # to avoid encoding issues downstream |
34
|
|
|
|
|
|
|
->allow_unknown(1) # encode null on bad value (instead of exception) |
35
|
|
|
|
|
|
|
->convert_blessed(1) # call TO_JSON on blessed ref, if it exists |
36
|
|
|
|
|
|
|
->allow_blessed(1) # encode null on blessed ref that can't be converted |
37
|
|
|
|
|
|
|
; |
38
|
|
|
|
|
|
|
}, |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# mdc_handler is a code ref that, when called, returns name-value pairs |
41
|
|
|
|
|
|
|
# of values from the MDC |
42
|
|
|
|
|
|
|
mdc_handler => sub { |
43
|
18
|
|
|
|
|
168
|
my $self = shift; |
44
|
|
|
|
|
|
|
|
45
|
18
|
100
|
|
|
|
318
|
return sub { } unless $self->include_mdc; |
46
|
|
|
|
|
|
|
|
47
|
5
|
|
|
|
|
96
|
my $mdc_hash = Log::Log4perl::MDC->get_context; |
48
|
|
|
|
|
|
|
|
49
|
5
|
100
|
|
|
|
107
|
if (my $mdc_field = $self->name_for_mdc) { |
50
|
|
|
|
|
|
|
return sub { |
51
|
5
|
100
|
|
|
|
40
|
return () unless %$mdc_hash; |
52
|
2
|
|
|
|
|
8
|
return ($mdc_field => $mdc_hash); |
53
|
2
|
|
|
|
|
27
|
}; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
else { |
56
|
|
|
|
|
|
|
return sub { |
57
|
10
|
50
|
|
|
|
199
|
return %$mdc_hash unless $self->canonical; |
58
|
10
|
|
|
|
|
93
|
return map { $_ => $mdc_hash->{$_} } sort keys %$mdc_hash; |
|
17
|
|
|
|
|
49
|
|
59
|
3
|
|
|
|
|
40
|
}; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
}, |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
field => sub { |
64
|
1
|
|
|
|
|
10
|
my $self = shift; |
65
|
|
|
|
|
|
|
|
66
|
1
|
|
|
|
|
2
|
my $content = {}; |
67
|
|
|
|
|
|
|
|
68
|
1
|
50
|
|
|
|
17
|
unless ($self->exclude_message) { |
69
|
0
|
|
|
|
|
0
|
$content->{message} = { value => '%m{chomp}' }; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
1
|
|
|
|
|
10
|
return $content; |
73
|
|
|
|
|
|
|
}, |
74
|
|
|
|
|
|
|
canonical => 0, |
75
|
|
|
|
|
|
|
include_mdc => 0, |
76
|
|
|
|
|
|
|
exclude_message => 0, |
77
|
|
|
|
|
|
|
name_for_mdc => undef, |
78
|
|
|
|
|
|
|
max_json_length_kb => 20, |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# if format_prefix is true, the prefix is a PatternLayout that itself can be formatted |
81
|
|
|
|
|
|
|
_prefix_layout => sub { |
82
|
3
|
|
|
|
|
26
|
my $self = shift; |
83
|
|
|
|
|
|
|
|
84
|
3
|
|
|
|
|
46
|
return Log::Log4perl::Layout::PatternLayout->new($self->prefix); |
85
|
|
|
|
|
|
|
}, |
86
|
7
|
|
|
7
|
|
4780
|
}; |
|
7
|
|
|
|
|
13623
|
|
|
7
|
|
|
|
|
137
|
|
87
|
7
|
|
|
7
|
|
21493
|
BEGIN { push our @ISA, 'Class::Tiny::Object' } |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
my $last_render_error; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub BUILD { ## no critic (RequireArgUnpacking) |
93
|
18
|
|
|
18
|
0
|
79620
|
my ($self, $args) = @_; |
94
|
|
|
|
|
|
|
|
95
|
18
|
|
|
|
|
68
|
delete $args->{value}; # => 'Log::Log4perl::Layout::JSON' |
96
|
|
|
|
|
|
|
|
97
|
18
|
50
|
|
|
|
84
|
if (my $arg = $args->{canonical}) { |
98
|
18
|
|
|
|
|
642
|
$self->codec->canonical($arg->{value}); |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
18
|
100
|
|
|
|
567
|
if ($args->{field}) { |
102
|
17
|
|
|
|
|
50
|
my $field = delete $args->{field}; |
103
|
17
|
|
|
|
|
76
|
$self->_build_field_values($field); |
104
|
17
|
|
|
|
|
2174
|
$self->field($field); |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# Optionally override encoding from ascii to utf8 |
108
|
18
|
100
|
|
|
|
229
|
if (my $arg = $args->{utf8}) { |
109
|
1
|
|
|
|
|
4
|
delete $args->{utf8}; |
110
|
1
|
|
|
|
|
19
|
$self->codec( $self->codec->ascii(0)->utf8(1) ); |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
18
|
|
|
|
|
74
|
for my $arg_name (qw( |
114
|
|
|
|
|
|
|
canonical prefix include_mdc exclude_message name_for_mdc max_json_length_kb format_prefix |
115
|
|
|
|
|
|
|
)) { |
116
|
126
|
100
|
|
|
|
526
|
my $arg = delete $args->{$arg_name} |
117
|
|
|
|
|
|
|
or next; |
118
|
42
|
|
|
|
|
789
|
$self->$arg_name( $arg->{value} ); |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
18
|
50
|
|
|
|
105
|
warn "Unknown configuration items: @{[ sort keys %$args ]}" |
|
0
|
|
|
|
|
0
|
|
122
|
|
|
|
|
|
|
if %$args; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
#use Data::Dumper; warn Dumper $self; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# sanity check to catch problems with the config at build time |
127
|
18
|
|
|
|
|
40
|
if (1) { |
128
|
18
|
|
|
|
|
40
|
undef $last_render_error; |
129
|
18
|
|
|
|
|
118
|
$self->render("Testing $self config", "test", 1, 0); |
130
|
18
|
50
|
|
|
|
1104
|
die $last_render_error if $last_render_error; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
18
|
|
|
|
|
65
|
return $self; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub _process_field_values { |
137
|
62
|
|
|
62
|
|
169
|
my($self, $m, $category, $priority, $caller_level, $fields, $layed_out) = @_; |
138
|
|
|
|
|
|
|
|
139
|
62
|
|
|
|
|
119
|
$caller_level++; |
140
|
|
|
|
|
|
|
|
141
|
62
|
|
66
|
|
|
1203
|
$fields //= $self->field; |
142
|
62
|
|
100
|
|
|
476
|
$layed_out //= {}; |
143
|
|
|
|
|
|
|
|
144
|
62
|
|
|
|
|
220
|
while (my($field, $value) = each %$fields) { |
145
|
190
|
100
|
66
|
|
|
14405
|
if (blessed($value) and blessed($value) eq 'Log::Log4perl::Layout::PatternLayout') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
146
|
166
|
|
|
|
|
490
|
$layed_out->{$field} = $value->render($m, $category, $priority, $caller_level); |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
elsif (ref($value) eq 'HASH') { |
149
|
20
|
|
50
|
|
|
93
|
$layed_out->{$field} //= {}; |
150
|
20
|
|
|
|
|
45
|
$self->_process_field_values($m, $category, $priority, $caller_level, $value, $layed_out->{$field}); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
elsif (ref($value) eq 'CODE') { |
153
|
4
|
|
|
|
|
15
|
$layed_out->{$field} = $value->($m, $category, $priority, $caller_level); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
62
|
|
|
|
|
5480
|
return $layed_out; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub _build_field_values { |
161
|
|
|
|
|
|
|
|
162
|
27
|
|
|
27
|
|
68
|
my($self, $field_hash) = @_; |
163
|
|
|
|
|
|
|
|
164
|
27
|
|
|
|
|
115
|
while (my($key, $value) = each %$field_hash) { |
165
|
86
|
100
|
100
|
|
|
6778
|
if (exists $value->{value} && !ref($value->{value})) { |
|
|
100
|
100
|
|
|
|
|
166
|
|
|
|
|
|
|
$field_hash->{$key} = Log::Log4perl::Layout::PatternLayout->new($value->{value}) |
167
|
74
|
|
|
|
|
336
|
} |
168
|
|
|
|
|
|
|
elsif (exists $value->{value} && ref($value->{value}) ne 'HASH') { |
169
|
|
|
|
|
|
|
$field_hash->{$key} = $value->{value} |
170
|
2
|
|
|
|
|
12
|
} |
171
|
|
|
|
|
|
|
else { |
172
|
10
|
|
|
|
|
24
|
$self->_build_field_values($value) |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
sub render { |
179
|
42
|
|
|
42
|
0
|
62709
|
my($self, $message, $category, $priority, $caller_level) = @_; |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
# increment caller_level to resolve caller appropriately |
182
|
42
|
|
|
|
|
87
|
$caller_level++; |
183
|
|
|
|
|
|
|
|
184
|
42
|
|
|
|
|
80
|
my $m = ''; |
185
|
42
|
|
|
|
|
86
|
my @data = (); |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# Will receive array ref if "warp_message" appender option is set to "0" |
188
|
42
|
100
|
66
|
|
|
235
|
if ( ref($message) eq 'ARRAY' and @{$message} > 1 and @{$message} % 2 == 0 ) { |
|
3
|
100
|
100
|
|
|
17
|
|
|
3
|
|
|
|
|
16
|
|
189
|
2
|
|
|
|
|
4
|
@data = @{$message}; |
|
2
|
|
|
|
|
6
|
|
190
|
2
|
|
|
|
|
5
|
$m = 'WARP_MESSAGE_0'; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
elsif ( ref($message) eq 'ARRAY' ) { |
193
|
1
|
|
|
|
|
2
|
@data = @{$message}; |
|
1
|
|
|
|
|
3
|
|
194
|
1
|
|
|
|
|
4
|
$m = shift @data; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
else { |
197
|
39
|
|
|
|
|
81
|
$m = $message; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
42
|
|
|
|
|
140
|
my $layed_out_fields = $self->_process_field_values($m, $category, $priority, $caller_level); |
201
|
|
|
|
|
|
|
|
202
|
42
|
|
|
|
|
1073
|
my @fields = ( |
203
|
|
|
|
|
|
|
%$layed_out_fields, |
204
|
|
|
|
|
|
|
@data, # append extra fields but before mdc |
205
|
|
|
|
|
|
|
$self->mdc_handler->($self) # MDC fields override non-MDC fields (not sure if this is a feature) |
206
|
|
|
|
|
|
|
); |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# might need to remove dummy message |
209
|
42
|
100
|
|
|
|
139
|
if ( $m eq 'WARP_MESSAGE_0' ) { |
210
|
2
|
|
|
|
|
9
|
for ( my $i = 0; $i < $#fields; $i += 2 ) { |
211
|
6
|
100
|
|
|
|
18
|
if ( $fields[$i] eq 'message' ) { |
212
|
2
|
|
|
|
|
5
|
splice( @fields, $i, 2 ); |
213
|
2
|
|
|
|
|
5
|
last; |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
42
|
|
|
|
|
747
|
my $max_json_length = $self->max_json_length_kb * 1024; |
219
|
42
|
|
|
|
|
310
|
my @dropped; |
220
|
|
|
|
|
|
|
my $json; |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
RETRY: { |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
# MDC items might contain refs that cause encode to croak |
225
|
|
|
|
|
|
|
# or the JSON might be too long |
226
|
|
|
|
|
|
|
# so we fall-back to include progressively less data data |
227
|
48
|
|
|
|
|
84
|
eval { |
|
48
|
|
|
|
|
92
|
|
228
|
48
|
|
|
|
|
794
|
$json = $self->codec->encode(+{ @fields }); |
229
|
|
|
|
|
|
|
|
230
|
48
|
100
|
|
|
|
1049
|
die sprintf "length %d > %d\n", length($json), $max_json_length |
231
|
|
|
|
|
|
|
if length($json) > $max_json_length; |
232
|
|
|
|
|
|
|
}; |
233
|
48
|
100
|
|
|
|
158
|
if ($@) { |
234
|
6
|
|
|
|
|
12
|
chomp $@; |
235
|
6
|
|
|
|
|
12
|
my $encode_error = $@; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# first look for any top-level field that's more than half of max_json_length |
238
|
|
|
|
|
|
|
# for non-ref values truncate the string and add some explanatory text |
239
|
|
|
|
|
|
|
# for ref values replace with undef |
240
|
|
|
|
|
|
|
# this should catch most cases of an individual field that's too big |
241
|
6
|
|
|
|
|
7
|
my @truncated; |
242
|
6
|
|
|
|
|
17
|
for my $i (0 .. @fields/2) { |
243
|
45
|
|
|
|
|
86
|
my ($k, $v) = ($fields[$i], $fields[$i+1]); |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
# we use eval here to protect against fatal encoding errors |
246
|
|
|
|
|
|
|
# (they'll get dealt with by the field pruning below) |
247
|
45
|
|
|
|
|
60
|
my $len; |
248
|
45
|
50
|
|
|
|
76
|
if (ref $v) { |
249
|
0
|
|
|
|
|
0
|
my $encoded = eval { $self->codec->encode(+{ $k => $v }) }; |
|
0
|
|
|
|
|
0
|
|
250
|
0
|
0
|
|
|
|
0
|
if (not defined $encoded) { |
251
|
0
|
|
|
|
|
0
|
$fields[$i+1] = undef; |
252
|
0
|
|
|
|
|
0
|
push @truncated, sprintf "%s %s set to undef after encoding error (%s)", $k, ref($v), $@; |
253
|
0
|
|
|
|
|
0
|
next; |
254
|
|
|
|
|
|
|
} |
255
|
0
|
|
|
|
|
0
|
$len = length $encoded; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
else { |
258
|
45
|
|
|
|
|
56
|
$len = length $v; |
259
|
|
|
|
|
|
|
} |
260
|
45
|
100
|
|
|
|
104
|
next if $len <= $max_json_length/2; |
261
|
|
|
|
|
|
|
|
262
|
3
|
50
|
|
|
|
10
|
if (ref $v) { |
263
|
0
|
|
|
|
|
0
|
$fields[$i+1] = undef; |
264
|
0
|
|
|
|
|
0
|
push @truncated, sprintf "truncated %s %s from %d to undef", $k, ref($v), $len; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
else { |
267
|
3
|
|
|
|
|
9
|
my $trunc_marker = sprintf("...[truncated, was %d chars total]...", $len); |
268
|
3
|
|
|
|
|
13
|
substr($fields[$i+1], ($max_json_length/2) - length($trunc_marker)) = $trunc_marker; |
269
|
3
|
|
|
|
|
15
|
push @truncated, sprintf "truncated %s from %d to %d", $k, $len, length($fields[$i+1]); |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
6
|
|
|
|
|
10
|
my $msg; |
274
|
6
|
100
|
|
|
|
11
|
if (@truncated) { |
275
|
2
|
|
|
|
|
6
|
$msg = join(", ", @truncated).", retrying"; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
else { |
278
|
4
|
|
|
|
|
9
|
my ($name) = splice @fields, -2; |
279
|
4
|
|
|
|
|
8
|
push @dropped, $name; |
280
|
4
|
|
|
|
|
12
|
$msg = "retrying without ".join(", ", @dropped); |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
# TODO get smarter here, especially if name_for_mdc is being used. |
284
|
|
|
|
|
|
|
# |
285
|
|
|
|
|
|
|
# Could encode each field and order by size then discard from top down. |
286
|
|
|
|
|
|
|
# Note: if we edit any refs we'd need to edit clones |
287
|
|
|
|
|
|
|
# If the 'message' field itself is > $max_json_length/2 then truncate |
288
|
|
|
|
|
|
|
# the message to $max_json_length/2 first so we don't loose all the context data. |
289
|
|
|
|
|
|
|
# Add an extra field to indicate truncation has happened? |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
|
292
|
6
|
|
|
|
|
21
|
$last_render_error = sprintf "Error encoding %s: %s (%s)", |
293
|
|
|
|
|
|
|
ref($self), $encode_error, $msg; |
294
|
|
|
|
|
|
|
# avoid warn due to recursion risk |
295
|
6
|
|
|
|
|
63
|
print STDERR "$last_render_error\n"; |
296
|
|
|
|
|
|
|
|
297
|
6
|
50
|
|
|
|
81
|
goto RETRY if @fields; |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
42
|
|
|
|
|
849
|
my $prefix = $self->prefix; |
302
|
|
|
|
|
|
|
|
303
|
42
|
100
|
|
|
|
913
|
if ($self->format_prefix) { |
304
|
6
|
|
|
|
|
127
|
return $self->_prefix_layout->render($message, $category, $priority, $caller_level) . $json . "\n"; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
else { |
307
|
36
|
|
|
|
|
768
|
return $self->prefix . $json . "\n"; |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
1; |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
__END__ |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
=pod |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
=encoding UTF-8 |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=head1 NAME |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
Log::Log4perl::Layout::JSON - Layout a log message as a JSON hash, including MDC data |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=head1 VERSION |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
version 0.58 |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=head1 SYNOPSIS |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
Example configuration: |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
log4perl.appender.Example.layout = Log::Log4perl::Layout::JSON |
332
|
|
|
|
|
|
|
log4perl.appender.Example.layout.field.message = %m{chomp} |
333
|
|
|
|
|
|
|
log4perl.appender.Example.layout.field.category = %c |
334
|
|
|
|
|
|
|
log4perl.appender.Example.layout.field.class = %C |
335
|
|
|
|
|
|
|
log4perl.appender.Example.layout.field.file = %F{1} |
336
|
|
|
|
|
|
|
log4perl.appender.Example.layout.field.sub = %M{1} |
337
|
|
|
|
|
|
|
log4perl.appender.Example.layout.include_mdc = 1 |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
# Note: Appender option! |
340
|
|
|
|
|
|
|
# log4perl.appender.Example.warp_message = 0 |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
See below for more configuration options. |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=head1 DESCRIPTION |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
This class implements a C<Log::Log4perl> layout format, similar to |
347
|
|
|
|
|
|
|
L<Log::Log4perl::Layout::PatternLayout> except that the output is a JSON hash. |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
The JSON hash is ASCII encoded, with no newlines or other whitespace, and is |
350
|
|
|
|
|
|
|
suitable for output, via Log::Log4perl appenders, to files and syslog etc. |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
Contextual data in the L<Log::Log4perl::MDC> hash will be included if |
353
|
|
|
|
|
|
|
L</include_mdc> is true. |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=head1 LAYOUT CONFIGURATION |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
=head2 field |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
Specify one or more fields to include in the JSON hash. The value is a string |
360
|
|
|
|
|
|
|
containing one of more L<Log::Log4perl::Layout::PatternLayout> placeholders. |
361
|
|
|
|
|
|
|
For example: |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
log4perl.appender.Example.layout.field.message = %m{chomp} |
364
|
|
|
|
|
|
|
log4perl.appender.Example.layout.field.category = %c |
365
|
|
|
|
|
|
|
log4perl.appender.Example.layout.field.where = %F{1}:%L |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
If no fields are specified, the default is C<message = %m{chomp}>. |
368
|
|
|
|
|
|
|
It is recommended that C<message> be the first field. |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=head2 prefix |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
Specify a prefix string for the JSON. For example: |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
log4perl.appender.Example.layout.prefix = @cee: |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
See http://blog.gerhards.net/2012/03/cee-enhanced-syslog-defined.html |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
=head2 format_prefix |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
If this is turned on, the prefix is treated as a |
381
|
|
|
|
|
|
|
L<Log::Log4perl::Layout::PatternLayout> string, and will be rendered as a |
382
|
|
|
|
|
|
|
pattern layout. |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
For example: |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
log4perl.appender.Example.layout.prefix = %m{chomp} @cee: |
387
|
|
|
|
|
|
|
log4perl.appender.Example.layout.format_prefix = 1 |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
Would log C<Hello World> as: |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
Hello World @cee:{ .. MDC as JSON ... } |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
See also L</prefix> |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=head2 exclude_message |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
Exclude the message from the JSON (default: 0). If you are logging the message |
398
|
|
|
|
|
|
|
in the prefix for example, you may want to omit the message from the JSON |
399
|
|
|
|
|
|
|
layout. |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=head2 include_mdc |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
Include the data in the Log::Log4perl::MDC hash. |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
log4perl.appender.Example.layout.include_mdc = 1 |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
See also L</name_for_mdc>. |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=head2 name_for_mdc |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
Use this name as the key in the JSON hash for the contents of MDC data |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
log4perl.appender.Example.layout.name_for_mdc = mdc |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
If not set then MDC data is placed at top level of the hash. |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
Where MDC field names match the names of fields defined by the Log4perl |
418
|
|
|
|
|
|
|
configuration then the MDC values take precedence. This is currently construde |
419
|
|
|
|
|
|
|
as a feature. |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
=head2 canonical |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
If true then use canonical order for hash keys when encoding the JSON. |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
log4perl.appender.Example.layout.canonical = 1 |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
This is mainly intended for testing. |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
=head2 max_json_length_kb |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
Set the maximum JSON length in kilobytes. The default is 20KB. |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
log4perl.appender.Example.layout.max_json_length_kb = 3.8 |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
This is useful where some downstream system has a limit on the maximum size of |
436
|
|
|
|
|
|
|
a message. |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
For example, rsyslog has a C<maxMessageSize> configuration parameter with a |
439
|
|
|
|
|
|
|
default of 4KB. Longer messages are simply truncated (which would corrupt the |
440
|
|
|
|
|
|
|
JSON). We use rsyslog with maxMessageSize set to 128KB. |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
If the JSON is larger than the specified size (not including L</prefix>) |
443
|
|
|
|
|
|
|
then some action is performed to reduce the size of the JSON. |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
Currently fields are simply removed until the JSON is within the size. |
446
|
|
|
|
|
|
|
The MDC field/fields are removed first and then the fields specified in the |
447
|
|
|
|
|
|
|
Log4perl config, in reverse order. A message is printed on C<STDERR> for each |
448
|
|
|
|
|
|
|
field removed. |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
In future this rather dumb logic will be replaced by something smarter. |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=head2 utf8 |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
Switch JSON encoding from ASCII to UTF-8. |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
=head2 warp_message = 0 |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
The C<warp_message> B<appender option> is used to specify the desired behavior |
459
|
|
|
|
|
|
|
for handling log calls with multiple arguments. |
460
|
|
|
|
|
|
|
The default behaviour (C<warp_message> not set>) is to concatenate all |
461
|
|
|
|
|
|
|
arguments using C<join( $Log::Log4perl::JOIN_MSG_ARRAY_CHAR, @log_args )> and |
462
|
|
|
|
|
|
|
setting a JSON field C<message> to this simple string. |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
If, on the other hand, C<warp_message = 0> is applied, then for log calls with |
465
|
|
|
|
|
|
|
multiple arguments these are considered name/value pairs and rendered to a |
466
|
|
|
|
|
|
|
hash-like JSON structure. |
467
|
|
|
|
|
|
|
For log calls with an odd number of arguments (3 or more), the first argument |
468
|
|
|
|
|
|
|
is considered the C<message> and the others are again considered |
469
|
|
|
|
|
|
|
name/value pairs. |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
See L<Log::Log4perl::Appender/Appenders Expecting Message Chunks> for more info |
472
|
|
|
|
|
|
|
on the configuration option. |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
=head2 EXAMPLE USING Log::Log4perl::MDC |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
local Log::Log4perl::MDC->get_context->{request} = { |
477
|
|
|
|
|
|
|
request_uri => $req->request_uri, |
478
|
|
|
|
|
|
|
query_parameters => $req->query_parameters |
479
|
|
|
|
|
|
|
}; |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
# ... |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
for my $id (@list_of_ids) { |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
local Log::Log4perl::MDC->get_context->{id} = $id; |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
do_something_useful($id); |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
Using code like that shown above, any log messages produced by |
492
|
|
|
|
|
|
|
do_something_useful() will automatically include the 'contextual data', |
493
|
|
|
|
|
|
|
showing the request URI, the hash of decoded query parameters, and the current |
494
|
|
|
|
|
|
|
value of $id. |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
If there's a C<$SIG{__WARN__}> handler setup to log warnings via C<Log::Log4perl> |
497
|
|
|
|
|
|
|
then any warnings from perl, such as uninitialized values, will also be logged |
498
|
|
|
|
|
|
|
with this context data included. |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
The use of C<local> ensures that contextual data doesn't stay in the MDC |
501
|
|
|
|
|
|
|
beyond the relevant scope. (For more complex cases you could use something like |
502
|
|
|
|
|
|
|
L<Scope::Guard> or simply take care to delete old data.) |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
=head1 HISTORY |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
Originally created and maintained through v0.002003 by Tim Bunce. Versions |
507
|
|
|
|
|
|
|
0.50 and later maintained by Michael Schout <mschout@cpan.org> |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=for Pod::Coverage BUILD |
510
|
|
|
|
|
|
|
codec |
511
|
|
|
|
|
|
|
mdc_handler |
512
|
|
|
|
|
|
|
render |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
=head1 SOURCE |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
The development version is on github at L<https://https://github.com/mschout/Log-Log4perl-Layout-JSON> |
517
|
|
|
|
|
|
|
and may be cloned from L<git://https://github.com/mschout/Log-Log4perl-Layout-JSON.git> |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
=head1 BUGS |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
Please report any bugs or feature requests on the bugtracker website |
522
|
|
|
|
|
|
|
L<https://github.com/mschout/Log-Log4perl-Layout-JSON/issues> |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
When submitting a bug or request, please include a test-file or a |
525
|
|
|
|
|
|
|
patch to an existing test-file that illustrates the bug or desired |
526
|
|
|
|
|
|
|
feature. |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
=head1 AUTHOR |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
Michael Schout <mschout@cpan.org> |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
This software is copyright (c) 2014 by Tim Bunce. |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
537
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
=cut |