← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:14 2021

Filename/usr/local/lib/perl5/site_perl/JSON.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sJSON::::BEGIN@11 JSON::BEGIN@11
0000s0sJSON::::BEGIN@4 JSON::BEGIN@4
0000s0sJSON::::BEGIN@5 JSON::BEGIN@5
0000s0sJSON::::BEGIN@6 JSON::BEGIN@6
0000s0sJSON::::BEGIN@7 JSON::BEGIN@7
0000s0sJSON::Backend::PP::::BEGIN@334JSON::Backend::PP::BEGIN@334
0000s0sJSON::Backend::PP::::__ANON__[:352]JSON::Backend::PP::__ANON__[:352]
0000s0sJSON::Backend::PP::::initJSON::Backend::PP::init
0000s0sJSON::Backend::PP::::is_ppJSON::Backend::PP::is_pp
0000s0sJSON::Backend::PP::::is_xsJSON::Backend::PP::is_xs
0000s0sJSON::::CORE:match JSON::CORE:match (opcode)
0000s0sJSON::::CORE:subst JSON::CORE:subst (opcode)
0000s0sJSON::::__load_pp JSON::__load_pp
0000s0sJSON::::__load_xs JSON::__load_xs
0000s0sJSON::::_load_pp JSON::_load_pp
0000s0sJSON::::_load_xs JSON::_load_xs
0000s0sJSON::::backend JSON::backend
0000s0sJSON::::false JSON::false
0000s0sJSON::::from_json JSON::from_json
0000s0sJSON::::import JSON::import
0000s0sJSON::::is_pp JSON::is_pp
0000s0sJSON::::is_xs JSON::is_xs
0000s0sJSON::::jsonToObj JSON::jsonToObj
0000s0sJSON::::null JSON::null
0000s0sJSON::::objToJson JSON::objToJson
0000s0sJSON::::property JSON::property
0000s0sJSON::::pureperl_only_methods JSON::pureperl_only_methods
0000s0sJSON::::require_xs_version JSON::require_xs_version
0000s0sJSON::::to_json JSON::to_json
0000s0sJSON::::true JSON::true
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package JSON;
2
3
4use strict;
5use Carp ();
6use Exporter;
7BEGIN { @JSON::ISA = 'Exporter' }
8
9@JSON::EXPORT = qw(from_json to_json jsonToObj objToJson encode_json decode_json);
10
11BEGIN {
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
17my %RequiredVersion = (
18 'JSON::PP' => '2.27203',
19 'JSON::XS' => '2.34',
20);
21
22# XS and PP common methods
23
24my @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
30my @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
35my @XSOnlyMethods = qw/allow_tags/; # Currently nothing
36
37my @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)
44my $_INSTALL_DONT_DIE = 1; # When _load_xs fails to load XS, don't die.
45my $_ALLOW_UNSUPPORTED = 0;
46my $_UNIV_CONV_BLESSED = 0;
47
48
49# Check the environment variable to decide worker module.
50
51unless ($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
86sub 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
133sub 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
142sub 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
154sub 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
174sub 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
- -
192sub true { $JSON::true }
193
194sub false { $JSON::false }
195
196sub null { undef; }
197
198
199sub require_xs_version { $RequiredVersion{'JSON::XS'}; }
200
201sub backend {
202 my $proto = shift;
203 $JSON::Backend;
204}
205
206#*module = *backend;
207
208
209sub is_xs {
210 return $_[0]->backend->is_xs;
211}
212
213
214sub is_pp {
215 return $_[0]->backend->is_pp;
216}
217
218
219sub pureperl_only_methods { @PPOnlyMethods; }
220
221
222sub 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
260sub __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
281sub _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
294sub __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
315sub _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
326package JSON::Backend::PP;
327
328sub 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
358sub is_xs { 0 };
359sub is_pp { 1 };
360
361#
362# To save memory, the below lines are read only when XS backend is used.
363#
364
365package JSON;
366
3671;
368__DATA__