Filename | /usr/local/lib/perl5/site_perl/JSON.pm |
Statements | Executed 0 statements in 0s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
0 | 0 | 0 | 0s | 0s | BEGIN@11 | JSON::
0 | 0 | 0 | 0s | 0s | BEGIN@4 | JSON::
0 | 0 | 0 | 0s | 0s | BEGIN@5 | JSON::
0 | 0 | 0 | 0s | 0s | BEGIN@6 | JSON::
0 | 0 | 0 | 0s | 0s | BEGIN@7 | JSON::
0 | 0 | 0 | 0s | 0s | BEGIN@334 | JSON::Backend::PP::
0 | 0 | 0 | 0s | 0s | __ANON__[:352] | JSON::Backend::PP::
0 | 0 | 0 | 0s | 0s | init | JSON::Backend::PP::
0 | 0 | 0 | 0s | 0s | is_pp | JSON::Backend::PP::
0 | 0 | 0 | 0s | 0s | is_xs | JSON::Backend::PP::
0 | 0 | 0 | 0s | 0s | CORE:match (opcode) | JSON::
0 | 0 | 0 | 0s | 0s | CORE:subst (opcode) | JSON::
0 | 0 | 0 | 0s | 0s | __load_pp | JSON::
0 | 0 | 0 | 0s | 0s | __load_xs | JSON::
0 | 0 | 0 | 0s | 0s | _load_pp | JSON::
0 | 0 | 0 | 0s | 0s | _load_xs | JSON::
0 | 0 | 0 | 0s | 0s | backend | JSON::
0 | 0 | 0 | 0s | 0s | false | JSON::
0 | 0 | 0 | 0s | 0s | from_json | JSON::
0 | 0 | 0 | 0s | 0s | import | JSON::
0 | 0 | 0 | 0s | 0s | is_pp | JSON::
0 | 0 | 0 | 0s | 0s | is_xs | JSON::
0 | 0 | 0 | 0s | 0s | jsonToObj | JSON::
0 | 0 | 0 | 0s | 0s | null | JSON::
0 | 0 | 0 | 0s | 0s | objToJson | JSON::
0 | 0 | 0 | 0s | 0s | property | JSON::
0 | 0 | 0 | 0s | 0s | pureperl_only_methods | JSON::
0 | 0 | 0 | 0s | 0s | require_xs_version | JSON::
0 | 0 | 0 | 0s | 0s | to_json | JSON::
0 | 0 | 0 | 0s | 0s | true | JSON::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package JSON; | ||||
2 | |||||
3 | |||||
4 | use strict; | ||||
5 | use Carp (); | ||||
6 | use Exporter; | ||||
7 | BEGIN { @JSON::ISA = 'Exporter' } | ||||
8 | |||||
9 | @JSON::EXPORT = qw(from_json to_json jsonToObj objToJson encode_json decode_json); | ||||
10 | |||||
11 | BEGIN { | ||||
12 | $JSON::VERSION = '2.97001'; | ||||
13 | $JSON::DEBUG = 0 unless (defined $JSON::DEBUG); | ||||
14 | $JSON::DEBUG = $ENV{ PERL_JSON_DEBUG } if exists $ENV{ PERL_JSON_DEBUG }; | ||||
15 | } | ||||
16 | |||||
17 | my %RequiredVersion = ( | ||||
18 | 'JSON::PP' => '2.27203', | ||||
19 | 'JSON::XS' => '2.34', | ||||
20 | ); | ||||
21 | |||||
22 | # XS and PP common methods | ||||
23 | |||||
24 | my @PublicMethods = qw/ | ||||
25 | ascii latin1 utf8 pretty indent space_before space_after relaxed canonical allow_nonref | ||||
26 | allow_blessed convert_blessed filter_json_object filter_json_single_key_object | ||||
27 | shrink max_depth max_size encode decode decode_prefix allow_unknown | ||||
28 | /; | ||||
29 | |||||
30 | my @Properties = qw/ | ||||
31 | ascii latin1 utf8 indent space_before space_after relaxed canonical allow_nonref | ||||
32 | allow_blessed convert_blessed shrink max_depth max_size allow_unknown | ||||
33 | /; | ||||
34 | |||||
35 | my @XSOnlyMethods = qw/allow_tags/; # Currently nothing | ||||
36 | |||||
37 | my @PPOnlyMethods = qw/ | ||||
38 | indent_length sort_by | ||||
39 | allow_singlequote allow_bignum loose allow_barekey escape_slash as_nonblessed | ||||
40 | /; # JSON::PP specific | ||||
41 | |||||
42 | |||||
43 | # used in _load_xs and _load_pp ($INSTALL_ONLY is not used currently) | ||||
44 | my $_INSTALL_DONT_DIE = 1; # When _load_xs fails to load XS, don't die. | ||||
45 | my $_ALLOW_UNSUPPORTED = 0; | ||||
46 | my $_UNIV_CONV_BLESSED = 0; | ||||
47 | |||||
48 | |||||
49 | # Check the environment variable to decide worker module. | ||||
50 | |||||
51 | unless ($JSON::Backend) { | ||||
52 | $JSON::DEBUG and Carp::carp("Check used worker module..."); | ||||
53 | |||||
54 | my $backend = exists $ENV{PERL_JSON_BACKEND} ? $ENV{PERL_JSON_BACKEND} : 1; | ||||
55 | |||||
56 | if ($backend eq '1') { | ||||
57 | $backend = 'JSON::XS,JSON::PP'; | ||||
58 | } | ||||
59 | elsif ($backend eq '0') { | ||||
60 | $backend = 'JSON::PP'; | ||||
61 | } | ||||
62 | elsif ($backend eq '2') { | ||||
63 | $backend = 'JSON::XS'; | ||||
64 | } | ||||
65 | $backend =~ s/\s+//g; | ||||
66 | |||||
67 | my @backend_modules = split /,/, $backend; | ||||
68 | while(my $module = shift @backend_modules) { | ||||
69 | if ($module =~ /JSON::XS/) { | ||||
70 | _load_xs($module, @backend_modules ? $_INSTALL_DONT_DIE : 0); | ||||
71 | } | ||||
72 | elsif ($module =~ /JSON::PP/) { | ||||
73 | _load_pp($module); | ||||
74 | } | ||||
75 | elsif ($module =~ /JSON::backportPP/) { | ||||
76 | _load_pp($module); | ||||
77 | } | ||||
78 | else { | ||||
79 | Carp::croak "The value of environmental variable 'PERL_JSON_BACKEND' is invalid."; | ||||
80 | } | ||||
81 | last if $JSON::Backend; | ||||
82 | } | ||||
83 | } | ||||
84 | |||||
85 | |||||
86 | sub import { | ||||
87 | my $pkg = shift; | ||||
88 | my @what_to_export; | ||||
89 | my $no_export; | ||||
90 | |||||
91 | for my $tag (@_) { | ||||
92 | if ($tag eq '-support_by_pp') { | ||||
93 | if (!$_ALLOW_UNSUPPORTED++) { | ||||
94 | JSON::Backend::XS | ||||
95 | ->support_by_pp(@PPOnlyMethods) if ($JSON::Backend->is_xs); | ||||
96 | } | ||||
97 | next; | ||||
98 | } | ||||
99 | elsif ($tag eq '-no_export') { | ||||
100 | $no_export++, next; | ||||
101 | } | ||||
102 | elsif ( $tag eq '-convert_blessed_universally' ) { | ||||
103 | my $org_encode = $JSON::Backend->can('encode'); | ||||
104 | eval q| | ||||
105 | require B; | ||||
106 | local $^W; | ||||
107 | no strict 'refs'; | ||||
108 | *{"${JSON::Backend}\::encode"} = sub { | ||||
109 | # only works with Perl 5.18+ | ||||
110 | local *UNIVERSAL::TO_JSON = sub { | ||||
111 | my $b_obj = B::svref_2object( $_[0] ); | ||||
112 | return $b_obj->isa('B::HV') ? { %{ $_[0] } } | ||||
113 | : $b_obj->isa('B::AV') ? [ @{ $_[0] } ] | ||||
114 | : undef | ||||
115 | ; | ||||
116 | }; | ||||
117 | $org_encode->(@_); | ||||
118 | }; | ||||
119 | | if ( !$_UNIV_CONV_BLESSED++ ); | ||||
120 | next; | ||||
121 | } | ||||
122 | push @what_to_export, $tag; | ||||
123 | } | ||||
124 | |||||
125 | return if ($no_export); | ||||
126 | |||||
127 | __PACKAGE__->export_to_level(1, $pkg, @what_to_export); | ||||
128 | } | ||||
129 | |||||
130 | |||||
131 | # OBSOLETED | ||||
132 | |||||
133 | sub jsonToObj { | ||||
134 | my $alternative = 'from_json'; | ||||
135 | if (defined $_[0] and UNIVERSAL::isa($_[0], 'JSON')) { | ||||
136 | shift @_; $alternative = 'decode'; | ||||
137 | } | ||||
138 | Carp::carp "'jsonToObj' will be obsoleted. Please use '$alternative' instead."; | ||||
139 | return JSON::from_json(@_); | ||||
140 | }; | ||||
141 | |||||
142 | sub objToJson { | ||||
143 | my $alternative = 'to_json'; | ||||
144 | if (defined $_[0] and UNIVERSAL::isa($_[0], 'JSON')) { | ||||
145 | shift @_; $alternative = 'encode'; | ||||
146 | } | ||||
147 | Carp::carp "'objToJson' will be obsoleted. Please use '$alternative' instead."; | ||||
148 | JSON::to_json(@_); | ||||
149 | }; | ||||
150 | |||||
151 | |||||
152 | # INTERFACES | ||||
153 | |||||
154 | sub to_json ($@) { | ||||
155 | if ( | ||||
156 | ref($_[0]) eq 'JSON' | ||||
157 | or (@_ > 2 and $_[0] eq 'JSON') | ||||
158 | ) { | ||||
159 | Carp::croak "to_json should not be called as a method."; | ||||
160 | } | ||||
161 | my $json = JSON->new; | ||||
162 | |||||
163 | if (@_ == 2 and ref $_[1] eq 'HASH') { | ||||
164 | my $opt = $_[1]; | ||||
165 | for my $method (keys %$opt) { | ||||
166 | $json->$method( $opt->{$method} ); | ||||
167 | } | ||||
168 | } | ||||
169 | |||||
170 | $json->encode($_[0]); | ||||
171 | } | ||||
172 | |||||
173 | |||||
174 | sub from_json ($@) { | ||||
175 | if ( ref($_[0]) eq 'JSON' or $_[0] eq 'JSON' ) { | ||||
176 | Carp::croak "from_json should not be called as a method."; | ||||
177 | } | ||||
178 | my $json = JSON->new; | ||||
179 | |||||
180 | if (@_ == 2 and ref $_[1] eq 'HASH') { | ||||
181 | my $opt = $_[1]; | ||||
182 | for my $method (keys %$opt) { | ||||
183 | $json->$method( $opt->{$method} ); | ||||
184 | } | ||||
185 | } | ||||
186 | |||||
187 | return $json->decode( $_[0] ); | ||||
188 | } | ||||
189 | |||||
- - | |||||
192 | sub true { $JSON::true } | ||||
193 | |||||
194 | sub false { $JSON::false } | ||||
195 | |||||
196 | sub null { undef; } | ||||
197 | |||||
198 | |||||
199 | sub require_xs_version { $RequiredVersion{'JSON::XS'}; } | ||||
200 | |||||
201 | sub backend { | ||||
202 | my $proto = shift; | ||||
203 | $JSON::Backend; | ||||
204 | } | ||||
205 | |||||
206 | #*module = *backend; | ||||
207 | |||||
208 | |||||
209 | sub is_xs { | ||||
210 | return $_[0]->backend->is_xs; | ||||
211 | } | ||||
212 | |||||
213 | |||||
214 | sub is_pp { | ||||
215 | return $_[0]->backend->is_pp; | ||||
216 | } | ||||
217 | |||||
218 | |||||
219 | sub pureperl_only_methods { @PPOnlyMethods; } | ||||
220 | |||||
221 | |||||
222 | sub property { | ||||
223 | my ($self, $name, $value) = @_; | ||||
224 | |||||
225 | if (@_ == 1) { | ||||
226 | my %props; | ||||
227 | for $name (@Properties) { | ||||
228 | my $method = 'get_' . $name; | ||||
229 | if ($name eq 'max_size') { | ||||
230 | my $value = $self->$method(); | ||||
231 | $props{$name} = $value == 1 ? 0 : $value; | ||||
232 | next; | ||||
233 | } | ||||
234 | $props{$name} = $self->$method(); | ||||
235 | } | ||||
236 | return \%props; | ||||
237 | } | ||||
238 | elsif (@_ > 3) { | ||||
239 | Carp::croak('property() can take only the option within 2 arguments.'); | ||||
240 | } | ||||
241 | elsif (@_ == 2) { | ||||
242 | if ( my $method = $self->can('get_' . $name) ) { | ||||
243 | if ($name eq 'max_size') { | ||||
244 | my $value = $self->$method(); | ||||
245 | return $value == 1 ? 0 : $value; | ||||
246 | } | ||||
247 | $self->$method(); | ||||
248 | } | ||||
249 | } | ||||
250 | else { | ||||
251 | $self->$name($value); | ||||
252 | } | ||||
253 | |||||
254 | } | ||||
255 | |||||
- - | |||||
258 | # INTERNAL | ||||
259 | |||||
260 | sub __load_xs { | ||||
261 | my ($module, $opt) = @_; | ||||
262 | |||||
263 | $JSON::DEBUG and Carp::carp "Load $module."; | ||||
264 | my $required_version = $RequiredVersion{$module} || ''; | ||||
265 | |||||
266 | eval qq| # spent 0s executing statements in string eval | ||||
267 | use $module $required_version (); | ||||
268 | |; | ||||
269 | |||||
270 | if ($@) { | ||||
271 | if (defined $opt and $opt & $_INSTALL_DONT_DIE) { | ||||
272 | $JSON::DEBUG and Carp::carp "Can't load $module...($@)"; | ||||
273 | return 0; | ||||
274 | } | ||||
275 | Carp::croak $@; | ||||
276 | } | ||||
277 | $JSON::BackendModuleXS = $module; | ||||
278 | return 1; | ||||
279 | } | ||||
280 | |||||
281 | sub _load_xs { | ||||
282 | my ($module, $opt) = @_; | ||||
283 | __load_xs($module, $opt) or return; | ||||
284 | |||||
285 | my $data = join("", <DATA>); # this code is from Jcode 2.xx. | ||||
286 | close(DATA); | ||||
287 | eval $data; | ||||
288 | JSON::Backend::XS->init($module); | ||||
289 | |||||
290 | return 1; | ||||
291 | }; | ||||
292 | |||||
293 | |||||
294 | sub __load_pp { | ||||
295 | my ($module, $opt) = @_; | ||||
296 | |||||
297 | $JSON::DEBUG and Carp::carp "Load $module."; | ||||
298 | my $required_version = $RequiredVersion{$module} || ''; | ||||
299 | |||||
300 | eval qq| use $module $required_version () |; # spent 0s executing statements in string eval | ||||
301 | |||||
302 | if ($@) { | ||||
303 | if ( $module eq 'JSON::PP' ) { | ||||
304 | $JSON::DEBUG and Carp::carp "Can't load $module ($@), so try to load JSON::backportPP"; | ||||
305 | $module = 'JSON::backportPP'; | ||||
306 | local $^W; # if PP installed but invalid version, backportPP redefines methods. | ||||
307 | eval qq| require $module |; | ||||
308 | } | ||||
309 | Carp::croak $@ if $@; | ||||
310 | } | ||||
311 | $JSON::BackendModulePP = $module; | ||||
312 | return 1; | ||||
313 | } | ||||
314 | |||||
315 | sub _load_pp { | ||||
316 | my ($module, $opt) = @_; | ||||
317 | __load_pp($module, $opt); | ||||
318 | |||||
319 | JSON::Backend::PP->init($module); | ||||
320 | }; | ||||
321 | |||||
322 | # | ||||
323 | # Helper classes for Backend Module (PP) | ||||
324 | # | ||||
325 | |||||
326 | package JSON::Backend::PP; | ||||
327 | |||||
328 | sub init { | ||||
329 | my ($class, $module) = @_; | ||||
330 | |||||
331 | # name may vary, but the module should (always) be a JSON::PP | ||||
332 | |||||
333 | local $^W; | ||||
334 | no strict qw(refs); # this routine may be called after JSON::Backend::XS init was called. | ||||
335 | *{"JSON::decode_json"} = \&{"JSON::PP::decode_json"}; | ||||
336 | *{"JSON::encode_json"} = \&{"JSON::PP::encode_json"}; | ||||
337 | *{"JSON::is_bool"} = \&{"JSON::PP::is_bool"}; | ||||
338 | |||||
339 | $JSON::true = ${"JSON::PP::true"}; | ||||
340 | $JSON::false = ${"JSON::PP::false"}; | ||||
341 | |||||
342 | push @JSON::Backend::PP::ISA, 'JSON::PP'; | ||||
343 | push @JSON::ISA, $class; | ||||
344 | $JSON::Backend = $class; | ||||
345 | $JSON::BackendModule = $module; | ||||
346 | ${"$class\::VERSION"} = $module->VERSION; | ||||
347 | |||||
348 | for my $method (@XSOnlyMethods) { | ||||
349 | *{"JSON::$method"} = sub { | ||||
350 | Carp::carp("$method is not supported in $module."); | ||||
351 | $_[0]; | ||||
352 | }; | ||||
353 | } | ||||
354 | |||||
355 | return 1; | ||||
356 | } | ||||
357 | |||||
358 | sub is_xs { 0 }; | ||||
359 | sub is_pp { 1 }; | ||||
360 | |||||
361 | # | ||||
362 | # To save memory, the below lines are read only when XS backend is used. | ||||
363 | # | ||||
364 | |||||
365 | package JSON; | ||||
366 | |||||
367 | 1; | ||||
368 | __DATA__ |