Codebase list liblog-dispatchouli-perl / ba3c9d0
log_event: structured event logs The documentation in this commit is probably what you want to read, but: this adds ->log_event and ->log_debug_event methods to log structured data in a form of the compact, human-readable-ish logfmt format, with automatic expansion of nested structures. It adds "proxy_ctx" for data to be logged on every line from a proxy logger, acting like the free-form "proxy_prefix" argument, but with logfmt data. Ricardo Signes 1 year, 6 months ago
3 changed file(s) with 412 addition(s) and 3 deletion(s). Raw diff Collapse all Expand all
+34
-1
lib/Log/Dispatchouli/Proxy.pm less more
3333 logger => $arg->{logger},
3434 debug => $arg->{debug},
3535 proxy_prefix => $arg->{proxy_prefix},
36 proxy_ctx => $arg->{proxy_ctx},
3637 };
3738
3839 bless $guts => $class;
4243 my ($self, $arg) = @_;
4344 $arg ||= {};
4445
45 (ref $self)->_new({
46 my @proxy_ctx = ($self->{proxy_ctx} // [])->@*;
47
48 if (my $ctx = $arg->{proxy_ctx}) {
49 @proxy_ctx = _ARRAY0($ctx)
50 ? (@proxy_ctx, @$ctx)
51 : (@proxy_ctx, $ctx->%{ sort keys %$ctx });
52 }
53
54 my $prox = (ref $self)->_new({
4655 parent => $self,
4756 logger => $self->logger,
4857 debug => $arg->{debug},
4958 muted => $arg->{muted},
5059 proxy_prefix => $arg->{proxy_prefix},
60 proxy_ctx => \@proxy_ctx,
5161 });
5262 }
5363
125135 $self->log($arg, @rest);
126136 }
127137
138 sub log_event {
139 my ($self, $event, $data) = @_;
140
141 return if $self->get_muted;
142
143 my $message = $self->logger->log_event($event, [
144 ($self->{proxy_ctx} ? $self->{proxy_ctx}->@* : ()),
145 (_ARRAY0($data) ? @$data : $data->%{ sort keys %$data })
146 ]);
147 }
148
149 sub log_debug_event {
150 my ($self, $event, $data) = @_;
151
152 return if $self->get_muted;
153 return unless $self->get_debug;
154
155 $self->logger->log_event($event, [
156 ($self->{proxy_ctx} ? $self->{proxy_ctx}->@* : ()),
157 (_ARRAY0($data) ? @$data : $data->%{ sort keys %$data })
158 ]);
159 }
160
128161 sub info { shift()->log(@_); }
129162 sub fatal { shift()->log_fatal(@_); }
130163 sub debug { shift()->log_debug(@_); }
+178
-2
lib/Log/Dispatchouli.pm less more
66 use File::Spec ();
77 use Log::Dispatch;
88 use Params::Util qw(_ARRAY0 _HASH0 _CODELIKE);
9 use Scalar::Util qw(blessed weaken);
9 use Scalar::Util qw(blessed refaddr weaken);
1010 use String::Flogger;
1111 use Try::Tiny 0.04;
1212
382382 $self->log($arg, @rest);
383383 }
384384
385 =method log_event
386
387 This method is like C<log>, but is used for structured logging instead of free
388 form text. It's invoked like this:
389
390 $logger->log($event_type => $data_ref);
391
392 C<$event_type> should be a simple string, probably a valid identifier, that
393 identifies the kind of event being logged. It is suggested, but not required,
394 that all events of the same type have the same kind of structured data in them.
395
396 C<$data_ref> is a set of key/value pairs of data to log in this event. It can
397 be an arrayref (in which case the ordering of pairs is preserved) or a hashref
398 (in which case they are sorted by key).
399
400 The logged string will be in logfmt format, meaning a series of key=value
401 pairs separated by spaces and following these rules:
402
403 =for :list
404 * an "identifier" is a string of printable ASCII characters between C<!> and
405 C<~>, excluding C<\> and C<=>
406 * keys must be valid identifiers
407 * if a key is empty, C<~> is used instead
408 * if a key contains characters not permitted in an identifier, they are
409 replaced by C<?>
410 * values must I<either> be valid identifiers, or be quoted
411 * quoted value start and end with C<">; inside the value, C<"> becomes C<\">
412 and C<\> becomes C<\\>
413
414 When values are undef, they are represented as C<~>.
415
416 When values are array references, the index/values are mapped over, so that:
417
418 key => [ 'a', 'b' ]
419
420 becomes
421
422 key.0=a key.1=b
423
424 When values are hash references, the key/values are mapped, with keys sorted,
425 so that:
426
427 key => { b => 2, a => 1 }
428
429 becomes
430
431 key.a=1 key.b=2
432
433 This expansion is performed recursively. If a value itself recurses,
434 appearances of a reference after the first time will be replaced with a string
435 like C<&foo.bar>, pointing to the first occurrence. I<This is not meant to be
436 a robust serialization mechanism.> It's just here to help you be a little
437 lazy. Don't push the limits.
438
439 =cut
440
441 # ASCII after SPACE but excluding = and "
442 my $IDENT_RE = qr{\A[\x21\x23-\x3C\x3E-\x7E]+\z};
443
444 sub _pairs_to_kvstr_aref {
445 my ($self, $aref, $seen, $prefix) = @_;
446
447 $seen //= {};
448
449 my @kvstrs;
450
451 KEY: for (my $i = 0; $i < @$aref; $i += 2) {
452 # replace non-ident-safe chars with ?
453 my $key = length $aref->[$i] ? "$aref->[$i]" : '~';
454 $key =~ tr/\x21\x23-\x3C\x3E-\x7E/?/c;
455
456 # If the prefix is "" you can end up with a pair like ".foo=1" which is
457 # weird but probably best. And that means you could end up with
458 # "foo..bar=1" which is also weird, but still probably for the best.
459 $key = "$prefix.$key" if defined $prefix;
460
461 my $value = $aref->[$i+1];
462
463 if (! defined $value) {
464 $value = '~missing~';
465 } elsif (ref $value) {
466 my $refaddr = refaddr $value;
467
468 if ($seen->{ $refaddr }) {
469 $value = $seen->{ $refaddr };
470 } elsif (_ARRAY0($value)) {
471 $seen->{ $refaddr } = "&$key";
472
473 push @kvstrs, $self->_pairs_to_kvstr_aref(
474 [ map {; $_ => $value->[$_] } (0 .. $#$value) ],
475 $seen,
476 $key,
477 )->@*;
478
479 next KEY;
480 } elsif (_HASH0($value)) {
481 $seen->{ $refaddr } = "&$key";
482
483 push @kvstrs, $self->_pairs_to_kvstr_aref(
484 [ $value->%{ sort keys %$value } ],
485 $seen,
486 $key,
487 )->@*;
488
489 next KEY;
490 } else {
491 $value = "$value"; # Meh.
492 }
493 }
494
495 my $str = "$key="
496 . ($value =~ $IDENT_RE
497 ? "$value"
498 : (q{"} . ($value =~ s{\\}{\\\\}gr =~ s{"}{\\"}gr) . q{"}));
499
500 push @kvstrs, $str;
501 }
502
503 return \@kvstrs;
504 }
505
506 sub _format_event {
507 my ($self, $aref) = @_;
508
509 my $kvstr_aref = $self->_pairs_to_kvstr_aref($aref, {}, undef);
510
511 return join q{ }, @$kvstr_aref;
512 }
513
514 sub log_event {
515 my ($self, $type, $data) = @_;
516
517 return if $self->get_muted;
518
519 my $message = $self->_format_event([
520 event => $type,
521 (_ARRAY0($data) ? @$data : $data->%{ sort keys %$data })
522 ]);
523
524 $self->dispatcher->log(
525 level => 'info',
526 message => $message,
527 );
528
529 return;
530 }
531
532 =method log_debug_event
533
534 This method is just like C<log_event>, but will log nothing unless the logger
535 has its C<debug> property set to true.
536
537 =cut
538
539 sub log_debug_event {
540 my ($self, $type, $data) = @_;
541
542 return unless $self->get_debug;
543
544 $self->log_event($type, $data);
545 }
546
385547 =method set_debug
386548
387549 $logger->set_debug($bool);
615777 = proxy_prefix
616778 This is a prefix that will be applied to anything the proxy logger logs, and
617779 cannot be changed.
780 = proxy_ctx
781 This is data to be inserted in front of event data logged through the proxy.
782 It will appear I<after> the C<event> key but before the logged event data. It
783 can be in the same format as the C<$data_ref> argument to C<log_event>. At
784 present, the context data is expanded on every logged event, but don't rely on
785 this, it may be optimized, in the future, to only be computed once.
618786 = debug
619787 This can be set to true or false to change the proxy's "am I in debug mode?"
620788 setting. It can be changed or cleared later on the proxy.
629797 my ($self, $arg) = @_;
630798 $arg ||= {};
631799
632 $self->proxy_class->_new({
800 my $proxy = $self->proxy_class->_new({
633801 parent => $self,
634802 logger => $self,
635803 proxy_prefix => $arg->{proxy_prefix},
636804 (exists $arg->{debug} ? (debug => ($arg->{debug} ? 1 : 0)) : ()),
637805 });
806
807 if (my $ctx = $arg->{proxy_ctx}) {
808 $proxy->{proxy_ctx} = _ARRAY0($ctx)
809 ? [ @$ctx ]
810 : [ $ctx->%{ sort keys %$ctx } ];
811 }
812
813 return $proxy;
638814 }
639815
640816 =head2 parent
+200
-0
t/events.t less more
0 use strict;
1 use warnings;
2
3 use JSON::MaybeXS;
4 use Log::Dispatchouli;
5 use Test::More 0.88;
6 use Test::Deep;
7
8 sub event_logs_ok {
9 my ($event_type, $data, $line, $desc) = @_;
10
11 local $Test::Builder::Level = $Test::Builder::Level+1;
12
13 my $logger = Log::Dispatchouli->new_tester({
14 log_pid => 0,
15 ident => 't/basic.t',
16 });
17
18 $logger->log_event($event_type, $data);
19
20 messages_ok($logger, [$line], $desc);
21 }
22
23 sub messages_ok {
24 my ($logger, $lines, $desc) = @_;
25
26 local $Test::Builder::Level = $Test::Builder::Level+1;
27
28 my @messages = map {; $_->{message} } $logger->events->@*;
29
30 my $ok = cmp_deeply(
31 \@messages,
32 $lines,
33 $desc,
34 );
35
36 $logger->clear_events;
37
38 unless ($ok) {
39 diag "GOT: $_" for @messages;
40 }
41
42 return $ok;
43 }
44
45 sub logger_trio {
46 my $logger = Log::Dispatchouli->new_tester({
47 log_pid => 0,
48 ident => 't/basic.t',
49 });
50
51 my $proxy1 = $logger->proxy({ proxy_ctx => { 'inner' => 'proxy' } });
52 my $proxy2 = $proxy1->proxy({ proxy_ctx => { 'outer' => 'proxy' } });
53
54 return ($logger, $proxy1, $proxy2);
55 }
56
57 subtest "very basic stuff" => sub {
58 event_logs_ok(
59 'world-series' => [ phl => 1, hou => 0, games => [ 'done', 'in-progress' ] ],
60 'event=world-series phl=1 hou=0 games.0=done games.1=in-progress',
61 "basic data with an arrayref value",
62 );
63
64 event_logs_ok(
65 'programmer-sleepiness' => {
66 weary => 8.62,
67 excited => 3.2,
68 motto => q{Never say "never" ever again.},
69 },
70 'event=programmer-sleepiness excited=3.2 motto="Never say \\"never\\" ever again." weary=8.62',
71 "basic data as a hashref",
72 );
73
74 event_logs_ok(
75 'rich-structure' => [
76 array => [
77 { name => [ qw(Ricardo Signes) ], limbs => { arms => 2, legs => 2 } },
78 [ 2, 4, 6 ],
79 ],
80 ],
81 join(q{ }, qw(
82 event=rich-structure
83 array.0.limbs.arms=2
84 array.0.limbs.legs=2
85 array.0.name.0=Ricardo
86 array.0.name.1=Signes
87 array.1.0=2
88 array.1.1=4
89 array.1.2=6
90 )),
91 "a structured nested a few levels",
92 );
93
94 event_logs_ok(
95 'empty-key' => { '' => 'disgusting' },
96 'event=empty-key ~=disgusting',
97 "cope with jerks putting empty keys into the data structure",
98 );
99
100 event_logs_ok(
101 'bogus-subkey' => { valid => { 'foo bar' => 'revolting' } },
102 'event=bogus-subkey valid.foo?bar=revolting',
103 "cope with bogus key characters in recursion",
104 );
105 };
106
107 subtest "very basic proxy operation" => sub {
108 my ($logger, $proxy1, $proxy2) = logger_trio();
109
110 $proxy2->log_event(pie_picnic => [
111 pies_eaten => 1.2,
112 joy_harvested => 6,
113 ]);
114
115 messages_ok(
116 $logger,
117 [
118 'event=pie_picnic inner=proxy outer=proxy pies_eaten=1.2 joy_harvested=6'
119 ],
120 'got the expected log output from events',
121 );
122 };
123
124 subtest "debugging in the proxies" => sub {
125 my ($logger, $proxy1, $proxy2) = logger_trio();
126
127 $proxy1->set_debug(1);
128
129 $logger->log_debug_event(0 => [ seq => 0 ]);
130 $proxy1->log_debug_event(1 => [ seq => 1 ]);
131 $proxy2->log_debug_event(2 => [ seq => 2 ]);
132
133 $proxy2->set_debug(0);
134
135 $logger->log_debug_event(0 => [ seq => 3 ]);
136 $proxy1->log_debug_event(1 => [ seq => 4 ]);
137 $proxy2->log_debug_event(2 => [ seq => 5 ]);
138
139 messages_ok(
140 $logger,
141 [
142 # 'event=0 seq=0', # not logged, debugging
143 'event=1 inner=proxy seq=1',
144 'event=2 inner=proxy outer=proxy seq=2',
145 # 'event=0 seq=3', # not logged, debugging
146 'event=1 inner=proxy seq=4',
147 # 'event=2 inner=proxy outer=proxy seq=5', # not logged, debugging
148 ],
149 'got the expected log output from events',
150 );
151 };
152
153 # NOT TESTED HERE: "mute" and "unmute", which rjbs believes are probably
154 # broken already. Their tests don't appear to test the important case of "root
155 # logger muted, proxy explicitly unmuted".
156
157 subtest "recursive structure" => sub {
158 my ($logger, $proxy1, $proxy2) = logger_trio();
159
160 my $struct = {};
161
162 $struct->{recurse} = $struct;
163
164 $logger->log_event('recursive-thing' => [ recursive => $struct ]);
165
166 messages_ok(
167 $logger,
168 [
169 'event=recursive-thing recursive.recurse=&recursive',
170 ],
171 "an event with recursive stuff terminates",
172 );
173 };
174
175 subtest "reused JSON booleans" => sub {
176 # It's not that this is extremely special, but we mostly don't want to
177 # recurse into the same reference value multiple times, but we also don't
178 # want the infuriating "reused boolean variable" you get from Dumper. This
179 # is just to make sure I don't accidentally break this case.
180 my ($logger, $proxy1, $proxy2) = logger_trio();
181
182 my $struct = {
183 b => [ JSON::MaybeXS::true(), JSON::MaybeXS::false() ],
184 f => [ (JSON::MaybeXS::false()) x 3 ],
185 t => [ (JSON::MaybeXS::true()) x 3 ],
186 };
187
188 $logger->log_event('tf-thing' => [ cond => $struct ]);
189
190 messages_ok(
191 $logger,
192 [
193 'event=tf-thing cond.b.0=1 cond.b.1=0 cond.f.0=0 cond.f.1=0 cond.f.2=0 cond.t.0=1 cond.t.1=1 cond.t.2=1',
194 ],
195 "JSON bools do what we expect",
196 );
197 };
198
199 done_testing;