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