line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package JSON::Slurper; |
2
|
1
|
|
|
1
|
|
63015
|
use strict; |
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
22
|
|
3
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
18
|
|
4
|
1
|
|
|
1
|
|
4
|
use Carp (); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
15
|
|
5
|
1
|
|
|
1
|
|
357
|
use Exporter::Shiny qw(slurp_json spurt_json); |
|
1
|
|
|
|
|
3329
|
|
|
1
|
|
|
|
|
6
|
|
6
|
1
|
|
|
1
|
|
62
|
use File::Basename (); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
11
|
|
7
|
1
|
|
|
1
|
|
378
|
use File::Slurper (); |
|
1
|
|
|
|
|
11167
|
|
|
1
|
|
|
|
|
18
|
|
8
|
1
|
|
|
1
|
|
6
|
use Scalar::Util (); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
966
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $VERSION = '0.12'; |
11
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( |
12
|
|
|
|
|
|
|
std => [qw(slurp_json spurt_json)], |
13
|
|
|
|
|
|
|
std_auto => [qw(-auto_ext slurp_json spurt_json)], |
14
|
|
|
|
|
|
|
slurp_auto => [qw(-auto_ext slurp_json)], |
15
|
|
|
|
|
|
|
spurt_auto => [qw(-auto_ext spurt_json)], |
16
|
|
|
|
|
|
|
); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
my $DEFAULT_ENCODER; |
19
|
|
|
|
|
|
|
sub _build_default_encoder { |
20
|
0
|
|
|
|
|
0
|
my $e_class = $ENV{JSON_SLURPER_NO_JSON_XS} ? do { require JSON::PP; 'JSON::PP' } |
|
0
|
|
|
|
|
0
|
|
21
|
1
|
|
|
|
|
5
|
: eval { require Cpanel::JSON::XS; Cpanel::JSON::XS->VERSION('4.09'); 1 } ? 'Cpanel::JSON::XS' |
|
1
|
|
|
|
|
15
|
|
|
1
|
|
|
|
|
4
|
|
22
|
1
|
50
|
|
1
|
|
4
|
: do { require JSON::PP; 'JSON::PP' }; |
|
0
|
50
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
23
|
1
|
|
|
|
|
12
|
my $encoder = $e_class->new |
24
|
|
|
|
|
|
|
->utf8 |
25
|
|
|
|
|
|
|
->pretty |
26
|
|
|
|
|
|
|
->canonical |
27
|
|
|
|
|
|
|
->allow_nonref |
28
|
|
|
|
|
|
|
->allow_blessed |
29
|
|
|
|
|
|
|
->convert_blessed |
30
|
|
|
|
|
|
|
->escape_slash; |
31
|
1
|
50
|
|
|
|
5
|
$encoder->stringify_infnan if $e_class eq 'Cpanel::JSON::XS'; |
32
|
1
|
|
|
|
|
5
|
return $encoder; |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub new { |
36
|
12
|
|
|
12
|
1
|
6406
|
my ($class, %args) = @_; |
37
|
|
|
|
|
|
|
|
38
|
12
|
|
|
|
|
16
|
my $encoder; |
39
|
12
|
100
|
|
|
|
24
|
if (exists $args{encoder}) { |
40
|
10
|
|
|
|
|
21
|
$encoder = _validate_encoder(delete $args{encoder}); |
41
|
|
|
|
|
|
|
} else { |
42
|
2
|
|
66
|
|
|
8
|
$encoder = ($DEFAULT_ENCODER ||= $class->_build_default_encoder); |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
5
|
|
|
|
|
10
|
my $auto_ext = delete $args{auto_ext}; |
46
|
|
|
|
|
|
|
|
47
|
5
|
100
|
|
|
|
18
|
Carp::croak "invalid constructor arguments provided: @{[join ',', keys %args]}" if %args; |
|
1
|
|
|
|
|
15
|
|
48
|
|
|
|
|
|
|
|
49
|
4
|
|
|
|
|
17
|
bless [$encoder, $auto_ext], $class; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub _generate_slurp_json { |
53
|
0
|
|
|
0
|
|
0
|
my ($class) = @_; |
54
|
0
|
|
|
|
|
0
|
my $auto_ext = exists $_[3]->{auto_ext}; |
55
|
0
|
0
|
|
|
|
0
|
my $imported_encoder = exists $_[3]->{encoder} ? _validate_encoder($_[3]->{encoder}) : undef; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
return sub ($;@) { |
58
|
0
|
|
|
0
|
|
0
|
my ($filename, $encoder) = @_; |
59
|
|
|
|
|
|
|
|
60
|
0
|
0
|
|
|
|
0
|
if (defined $encoder) { |
|
|
0
|
|
|
|
|
|
61
|
0
|
|
|
|
|
0
|
_validate_encoder($encoder); |
62
|
|
|
|
|
|
|
} elsif ($imported_encoder) { |
63
|
0
|
|
|
|
|
0
|
$encoder = $imported_encoder; |
64
|
|
|
|
|
|
|
} else { |
65
|
0
|
|
0
|
|
|
0
|
$encoder = ($DEFAULT_ENCODER ||= $class->_build_default_encoder); |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
0
|
|
|
|
|
0
|
my $wantarray = wantarray; |
69
|
0
|
0
|
|
|
|
0
|
unless (defined wantarray) { |
70
|
0
|
|
|
|
|
0
|
Carp::carp 'slurp_json requested without a used return value. Returning from slurp_json'; |
71
|
0
|
|
|
|
|
0
|
return; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
0
|
0
|
0
|
|
|
0
|
if ($auto_ext and not ((File::Basename::fileparse($filename, qr/\.[^.]*/xm))[2])) { |
75
|
0
|
|
|
|
|
0
|
$filename = "$filename.json"; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
0
|
|
|
|
|
0
|
my $slurped = $encoder->decode(File::Slurper::read_binary($filename)); |
79
|
|
|
|
|
|
|
|
80
|
0
|
0
|
0
|
|
|
0
|
if ($wantarray and my $ref = ref $slurped) { |
81
|
0
|
0
|
|
|
|
0
|
return @$slurped if $ref eq 'ARRAY'; |
82
|
0
|
0
|
|
|
|
0
|
return %$slurped if $ref eq 'HASH'; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
0
|
|
|
|
|
0
|
return $slurped; |
86
|
|
|
|
|
|
|
} |
87
|
0
|
|
|
|
|
0
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub slurp { |
90
|
0
|
|
|
0
|
1
|
0
|
my ($self, $filename) = @_; |
91
|
|
|
|
|
|
|
|
92
|
0
|
|
|
|
|
0
|
my $wantarray = wantarray; |
93
|
0
|
0
|
|
|
|
0
|
unless (defined wantarray) { |
94
|
0
|
|
|
|
|
0
|
Carp::carp 'slurp requested without a used return value. Returning from slurp'; |
95
|
0
|
|
|
|
|
0
|
return; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
0
|
0
|
0
|
|
|
0
|
if ($self->[1] and not ((File::Basename::fileparse($filename, qr/\.[^.]*/xm))[2])) { |
99
|
0
|
|
|
|
|
0
|
$filename = "$filename.json"; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
0
|
|
|
|
|
0
|
my $slurped = $self->[0]->decode(File::Slurper::read_binary($filename)); |
103
|
0
|
0
|
0
|
|
|
0
|
if ($wantarray and my $ref = ref $slurped) { |
104
|
0
|
0
|
|
|
|
0
|
return @$slurped if $ref eq 'ARRAY'; |
105
|
0
|
0
|
|
|
|
0
|
return %$slurped if $ref eq 'HASH'; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
0
|
|
|
|
|
0
|
return $slurped; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub _generate_spurt_json { |
112
|
0
|
|
|
0
|
|
0
|
my ($class) = @_; |
113
|
0
|
|
|
|
|
0
|
my $auto_ext = exists $_[3]->{auto_ext}; |
114
|
0
|
0
|
|
|
|
0
|
my $imported_encoder = exists $_[3]->{encoder} ? _validate_encoder($_[3]->{encoder}) : undef; |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
return sub ($$;@) { |
117
|
0
|
|
|
0
|
|
0
|
my ($data, $filename, $encoder) = @_; |
118
|
|
|
|
|
|
|
|
119
|
0
|
0
|
|
|
|
0
|
if (defined $encoder) { |
|
|
0
|
|
|
|
|
|
120
|
0
|
|
|
|
|
0
|
_validate_encoder($encoder); |
121
|
|
|
|
|
|
|
} elsif ($imported_encoder) { |
122
|
0
|
|
|
|
|
0
|
$encoder = $imported_encoder; |
123
|
|
|
|
|
|
|
} else { |
124
|
0
|
|
0
|
|
|
0
|
$encoder = ($DEFAULT_ENCODER ||= $class->_build_default_encoder); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
0
|
0
|
0
|
|
|
0
|
if ($auto_ext and not ((File::Basename::fileparse($filename, qr/\.[^.]*/xm))[2])) { |
128
|
0
|
|
|
|
|
0
|
$filename = "$filename.json"; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
0
|
|
|
|
|
0
|
File::Slurper::write_binary($filename, $encoder->encode($data)); |
132
|
|
|
|
|
|
|
} |
133
|
0
|
|
|
|
|
0
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub spurt { |
136
|
0
|
|
|
0
|
1
|
0
|
my ($self, $data, $filename) = @_; |
137
|
|
|
|
|
|
|
|
138
|
0
|
0
|
0
|
|
|
0
|
if ($self->[1] and not ((File::Basename::fileparse($filename, qr/\.[^.]*/xm))[2])) { |
139
|
0
|
|
|
|
|
0
|
$filename = "$filename.json"; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
0
|
File::Slurper::write_binary($filename, $self->[0]->encode($data)); |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub _validate_encoder { |
146
|
10
|
|
|
10
|
|
16
|
my ($encoder) = @_; |
147
|
|
|
|
|
|
|
|
148
|
10
|
100
|
100
|
|
|
123
|
Carp::confess 'encoder must be an object that can encode and decode' |
|
|
|
100
|
|
|
|
|
149
|
|
|
|
|
|
|
unless Scalar::Util::blessed($encoder) && $encoder->can('encode') && $encoder->can('decode'); |
150
|
|
|
|
|
|
|
|
151
|
3
|
|
|
|
|
7
|
return $encoder; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
1; |
155
|
|
|
|
|
|
|
__END__ |