1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
package JSON::Dumper::Compact;
use JSON::MaybeXS;
use Mu::Tiny;
use Class::Method::Modifiers;
our $VERSION = '0.006000';
$VERSION =~ tr/_//d;
extends 'Data::Dumper::Compact';
lazy json_obj => sub {
JSON->new
->allow_nonref(1)
->relaxed(1)
->filter_json_single_key_object(__bless__ => sub {
bless($_[0][1], $_[0][0]);
});
};
sub _json_decode { shift->json_obj->decode(@_) }
sub _build_dumper { my $j = shift->json_obj; sub { $j->encode($_[0]) } }
sub _format_el { shift->_format(@_).',' }
sub _format_hashkey { $_[0]->json_obj->encode($_[1]).':' }
sub _format_string { '"'.$_[1].'"' }
sub _format_thing { $_[1] }
around _expand_blessed => sub {
my ($orig, $self) = (shift, shift);
my ($blessed) = @_;
return $self->expand($blessed->TO_JSON) if $blessed->can('TO_JSON');
return $self->$orig(@_);
};
sub _format_blessed {
my ($self, $payload) = @_;
my ($content, $class) = @$payload;
$self->_format([ hash => [
[ '__bless__' ],
{ '__bless__' => [ array => [ [ string => $class ], $content ] ] },
] ]);
}
sub _format_ref {
my ($self, $payload) = @_;
my %subst = ('/' => '~1', '~' => '~0');
my @path = map { (my $x = $_->[1]) =~ s{[/~]}{$subst{$_}}eg; $x } @$payload;
return $self->format([ hash => [
[ '$ref' ],
{ '$ref' => [ string => join('/', '#', @path) ] },
] ]);
}
sub encode { shift->dump(@_) }
sub decode {
my ($self, $data, $opts) = @_;
$self->_optify($opts, _json_decode => $data);
}
1;
=head1 NAME
JSON::Dumper::Compact - JSON processing with L<Data::Dumper::Compact> aesthetics
=head1 SYNOPSIS
use JSON::Dumper::Compact 'jdc';
my $json = jdc($data);
=head1 DESCRIPTION
JSON::Dumper::Compact is a subclass of L<Data::Dumper::Compact> that turns
arrayrefs and hashrefs instead into JSON.
Deep data structures are rendered highly compactly:
[
"1556933590.65383", "Fri May 3 18:33:10 2019", 26794, "INFO", 3,
[ "SRV:8FB66F32" ], [ [
"/opt/voice-srvc-native/bin/async-srvc-att-gateway-poller", 33,
"NERV::Voice::SRV::Native::AsyncSRVATTGatewayPoller::main",
] ],
"batch_nena_messages returned", "OK", 6, { "FILENAME": "lqxw020323" },
1556933584, "lqxw020323",
]
To ease debugging, blessed references without a C<TO_JSON> method are
rendered as an object with a single two-element arrayref value:
{ "__bless__": [
"The::Class",
{ "the": "object" },
] }
=head1 METHODS
In addition to the L<Data::Dumper::Compact> methods, we provide:
=head2 encode
JSON::Dumper::Compact->encode($data, \%opts?);
$jdc->encode($data, \%opts?);
Operates identically to L<Data::Dumper::Compact/dump> but named to be less
confusing to code expecting a JSON object.
=head2 decode
JSON::Dumper::Compact->decode($string, \%opts?);
$jdc->decode($string, \%opts);
Runs the supplied string through an L<JSON::MaybeXS> C<decode> with options
set to be able to reliably reparse what we can currently format - notably
setting C<relaxed> to allow for trailing commas and using
C<filter_json_single_key_object> to re-inflate blessed objects.
Note that using this method on untrusted data is a security risk. While
C<encode>/C<dump> should be usable for JSON formatting, in general,
C<decode> fully rehydrates for debugging purposes and as such can e.g.
cause DESTROY methods to be called unexpectedly, which can allow a
malicious user to do things to your perl5 VM. Rather than using
debugging specific code on untrusted data, use L<JSON::MaybeXS> or
L<Mojo::JSON> directly (if the C<encode> output doesn't parse correctly
via other libraries, please report that as a bug)..
DO NOT USE THIS METHOD ON UNTRUSTED DATA IT WAS NOT DESIGNED TO BE SECURE.
=head1 COPYRIGHT
Copyright (c) 2019 the L<Data::Dumper::Compact/AUTHOR> and
L<Data::Dumper::Compact/CONTRIBUTORS> as listed in L<Data::Dumper::Compact>.
=head1 LICENSE
This library is free software and may be distributed under the same terms
as perl itself. See L<https://dev.perl.org/licenses/>.
=cut
|
