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