← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Wed Dec 14 15:33:55 2022
Reported on Wed Dec 14 15:40:02 2022

Filename/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/JSON/MaybeXS.pm
StatementsExecuted 116427 statements in 233ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
5819721175ms212msJSON::MaybeXS::::is_boolJSON::MaybeXS::is_bool
1113.32ms10.2msJSON::MaybeXS::::_choose_json_moduleJSON::MaybeXS::_choose_json_module
1112.07ms2.18msJSON::MaybeXS::::BEGIN@5JSON::MaybeXS::BEGIN@5
11130µs10.3msJSON::MaybeXS::::BEGIN@29JSON::MaybeXS::BEGIN@29
11124µs26µsJSON::MaybeXS::::BEGIN@3JSON::MaybeXS::BEGIN@3
11124µs35µsJSON::MaybeXS::::newJSON::MaybeXS::new
1118µs16µsJSON::MaybeXS::::BEGIN@32JSON::MaybeXS::BEGIN@32
1115µs41µsJSON::MaybeXS::::BEGIN@4JSON::MaybeXS::BEGIN@4
1115µs5µsJSON::MaybeXS::::BEGIN@54JSON::MaybeXS::BEGIN@54
1113µs3µsJSON::MaybeXS::::BEGIN@66JSON::MaybeXS::BEGIN@66
0000s0sJSON::MaybeXS::::JSONJSON::MaybeXS::JSON
0000s0sJSON::MaybeXS::::from_jsonJSON::MaybeXS::from_json
0000s0sJSON::MaybeXS::::to_jsonJSON::MaybeXS::to_json
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package JSON::MaybeXS;
2
3235µs228µs
# spent 26µs (24+2) within JSON::MaybeXS::BEGIN@3 which was called: # once (24µs+2µs) by JSON::Schema::Modern::BEGIN@18 at line 3
use strict;
# spent 26µs making 1 call to JSON::MaybeXS::BEGIN@3 # spent 2µs making 1 call to strict::import
4222µs277µs
# spent 41µs (5+36) within JSON::MaybeXS::BEGIN@4 which was called: # once (5µs+36µs) by JSON::Schema::Modern::BEGIN@18 at line 4
use warnings FATAL => 'all';
# spent 41µs making 1 call to JSON::MaybeXS::BEGIN@4 # spent 36µs making 1 call to warnings::import
52744µs22.25ms
# spent 2.18ms (2.07+106µs) within JSON::MaybeXS::BEGIN@5 which was called: # once (2.07ms+106µs) by JSON::Schema::Modern::BEGIN@18 at line 5
use base qw(Exporter);
# spent 2.18ms making 1 call to JSON::MaybeXS::BEGIN@5 # spent 70µs making 1 call to base::import
6
710sour $VERSION = '1.004004';
811µs$VERSION =~ tr/_//d;
9
10
# spent 10.2ms (3.32+6.93) within JSON::MaybeXS::_choose_json_module which was called: # once (3.32ms+6.93ms) by JSON::MaybeXS::BEGIN@29 at line 30
sub _choose_json_module {
1110s return 'Cpanel::JSON::XS' if $INC{'Cpanel/JSON/XS.pm'};
1210s return 'JSON::XS' if $INC{'JSON/XS.pm'} && eval { JSON::XS->VERSION(3.0); 1 };
13
1410s my @err;
15
163794µs return 'Cpanel::JSON::XS' if eval { require Cpanel::JSON::XS; 1; };
17 push @err, "Error loading Cpanel::JSON::XS: $@";
18
19 return 'JSON::XS' if eval { require JSON::XS; JSON::XS->VERSION(3.0); 1; };
20 push @err, "Error loading JSON::XS: $@";
21
22 return 'JSON::PP' if eval { require JSON::PP; 1 };
23 push @err, "Error loading JSON::PP: $@";
24
25 die join( "\n", "Couldn't load a JSON module:", @err );
26
27}
28
29
# spent 10.3ms (30µs+10.3) within JSON::MaybeXS::BEGIN@29 which was called: # once (30µs+10.3ms) by JSON::Schema::Modern::BEGIN@18 at line 35
BEGIN {
3011µs110.2ms our $JSON_Class = _choose_json_module();
# spent 10.2ms making 1 call to JSON::MaybeXS::_choose_json_module
3114µs148µs $JSON_Class->import(qw(encode_json decode_json));
# spent 48µs making 1 call to Exporter::import
32245µs224µs
# spent 16µs (8+8) within JSON::MaybeXS::BEGIN@32 which was called: # once (8µs+8µs) by JSON::Schema::Modern::BEGIN@18 at line 32
no strict 'refs';
# spent 16µs making 1 call to JSON::MaybeXS::BEGIN@32 # spent 8µs making 1 call to strict::unimport
33 *$_ = $JSON_Class->can($_)
34114µs22µs for qw(true false);
# spent 2µs making 2 calls to UNIVERSAL::can, avg 1µs/call
351237µs110.3ms}
# spent 10.3ms making 1 call to JSON::MaybeXS::BEGIN@29
36
3711µsour @EXPORT = qw(encode_json decode_json JSON);
3811µsmy @EXPORT_ALL = qw(is_bool);
3910sour @EXPORT_OK = qw(is_bool to_json from_json);
4014µsour %EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_ALL ],
41 legacy => [ @EXPORT, @EXPORT_OK ],
42 );
43
44sub JSON () { our $JSON_Class }
45
46
# spent 35µs (24+11) within JSON::MaybeXS::new which was called: # once (24µs+11µs) by JSON::Schema::Modern::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/JSON/Schema/Modern.pm:870] at line 870 of JSON/Schema/Modern.pm
sub new {
4710s shift;
4812µs my %args = @_ == 1 ? %{$_[0]} : @_;
49113µs19µs my $new = (our $JSON_Class)->new;
# spent 9µs making 1 call to Cpanel::JSON::XS::new
50118µs52µs $new->$_($args{$_}) for keys %args;
# spent 1µs making 1 call to Cpanel::JSON::XS::allow_nonref # spent 1µs making 1 call to Cpanel::JSON::XS::canonical # spent 0s making 1 call to Cpanel::JSON::XS::allow_bignum # spent 0s making 1 call to Cpanel::JSON::XS::convert_blessed # spent 0s making 1 call to Cpanel::JSON::XS::utf8
5114µs return $new;
52}
53
54284µs15µs
# spent 5µs within JSON::MaybeXS::BEGIN@54 which was called: # once (5µs+0s) by JSON::Schema::Modern::BEGIN@18 at line 54
use Scalar::Util ();
# spent 5µs making 1 call to JSON::MaybeXS::BEGIN@54
55
56
# spent 212ms (175+36.9) within JSON::MaybeXS::is_bool which was called 58197 times, avg 4µs/call: # 41690 times (97.8ms+25.1ms) by JSON::Schema::Modern::Utilities::get_type at line 99 of JSON/Schema/Modern/Utilities.pm, avg 3µs/call # 16507 times (77.5ms+11.7ms) by JSON::Schema::Modern::Utilities::is_type at line 59 of JSON/Schema/Modern/Utilities.pm, avg 5µs/call
sub is_bool {
575819710.5ms die 'is_bool is not a method' if $_[1];
58
5958197219ms6458336.9ms Scalar::Util::blessed($_[0])
# spent 29.2ms making 58197 calls to Scalar::Util::blessed, avg 502ns/call # spent 7.62ms making 6386 calls to UNIVERSAL::isa, avg 1µs/call
60 and ($_[0]->isa('JSON::PP::Boolean')
61 or $_[0]->isa('Cpanel::JSON::XS::Boolean')
62 or $_[0]->isa('JSON::XS::Boolean'));
63}
64
65# (mostly) CopyPasta from JSON.pm version 2.90
662782µs13µs
# spent 3µs within JSON::MaybeXS::BEGIN@66 which was called: # once (3µs+0s) by JSON::Schema::Modern::BEGIN@18 at line 66
use Carp ();
# spent 3µs making 1 call to JSON::MaybeXS::BEGIN@66
67
68sub from_json ($@) {
69 if ( ref($_[0]) =~ /^JSON/ or $_[0] =~ /^JSON/ ) {
70 Carp::croak "from_json should not be called as a method.";
71 }
72 my $json = JSON()->new;
73
74 if (@_ == 2 and ref $_[1] eq 'HASH') {
75 my $opt = $_[1];
76 for my $method (keys %$opt) {
77 $json->$method( $opt->{$method} );
78 }
79 }
80
81 return $json->decode( $_[0] );
82}
83
84sub to_json ($@) {
85 if (
86 ref($_[0]) =~ /^JSON/
87 or (@_ > 2 and $_[0] =~ /^JSON/)
88 ) {
89 Carp::croak "to_json should not be called as a method.";
90 }
91 my $json = JSON()->new;
92
93 if (@_ == 2 and ref $_[1] eq 'HASH') {
94 my $opt = $_[1];
95 for my $method (keys %$opt) {
96 $json->$method( $opt->{$method} );
97 }
98 }
99
100 $json->encode($_[0]);
101}
102
103113µs1;
104
105=head1 NAME
106
107JSON::MaybeXS - Use L<Cpanel::JSON::XS> with a fallback to L<JSON::XS> and L<JSON::PP>
108
109=head1 SYNOPSIS
110
111 use JSON::MaybeXS;
112
113 my $data_structure = decode_json($json_input);
114
115 my $json_output = encode_json($data_structure);
116
117 my $json = JSON()->new;
118
119 my $json_with_args = JSON::MaybeXS->new(utf8 => 1); # or { utf8 => 1 }
120
121=head1 DESCRIPTION
122
123This module first checks to see if either L<Cpanel::JSON::XS> or
124L<JSON::XS> (at at least version 3.0)
125is already loaded, in which case it uses that module. Otherwise
126it tries to load L<Cpanel::JSON::XS>, then L<JSON::XS>, then L<JSON::PP>
127in order, and either uses the first module it finds or throws an error.
128
129It then exports the C<encode_json> and C<decode_json> functions from the
130loaded module, along with a C<JSON> constant that returns the class name
131for calling C<new> on.
132
133If you're writing fresh code rather than replacing L<JSON.pm|JSON> usage, you might
134want to pass options as constructor args rather than calling mutators, so
135we provide our own C<new> method that supports that.
136
137=head1 EXPORTS
138
139C<encode_json>, C<decode_json> and C<JSON> are exported by default; C<is_bool>
140is exported on request.
141
142To import only some symbols, specify them on the C<use> line:
143
144 use JSON::MaybeXS qw(encode_json decode_json is_bool); # functions only
145
146 use JSON::MaybeXS qw(JSON); # JSON constant only
147
148To import all available sensible symbols (C<encode_json>, C<decode_json>, and
149C<is_bool>), use C<:all>:
150
151 use JSON::MaybeXS ':all';
152
153To import all symbols including those needed by legacy apps that use L<JSON::PP>:
154
155 use JSON::MaybeXS ':legacy';
156
157This imports the C<to_json> and C<from_json> symbols as well as everything in
158C<:all>. NOTE: This is to support legacy code that makes extensive
159use of C<to_json> and C<from_json> which you are not yet in a position to
160refactor. DO NOT use this import tag in new code, in order to avoid
161the crawling horrors of getting UTF-8 support subtly wrong. See the
162documentation for L<JSON> for further details.
163
164=head2 encode_json
165
166This is the C<encode_json> function provided by the selected implementation
167module, and takes a perl data structure which is serialised to JSON text.
168
169 my $json_text = encode_json($data_structure);
170
171=head2 decode_json
172
173This is the C<decode_json> function provided by the selected implementation
174module, and takes a string of JSON text to deserialise to a perl data structure.
175
176 my $data_structure = decode_json($json_text);
177
178=head2 to_json, from_json
179
180See L<JSON> for details. These are included to support legacy code
181B<only>.
182
183=head2 JSON
184
185The C<JSON> constant returns the selected implementation module's name for
186use as a class name - so:
187
188 my $json_obj = JSON()->new; # returns a Cpanel::JSON::XS or JSON::PP object
189
190and that object can then be used normally:
191
192 my $data_structure = $json_obj->decode($json_text); # etc.
193
194The use of parentheses here is optional, and only used as a hint to the reader
195that this use of C<JSON> is a I<subroutine> call, I<not> a class name.
196
197=head2 is_bool
198
199 $is_boolean = is_bool($scalar)
200
201Returns true if the passed scalar represents either C<true> or
202C<false>, two constants that act like C<1> and C<0>, respectively
203and are used to represent JSON C<true> and C<false> values in Perl.
204
205Since this is a bare sub in the various backend classes, it cannot be called as
206a class method like the other interfaces; it must be called as a function, with
207no invocant. It supports the representation used in all JSON backends.
208
209Available since version 1.002004.
210
211=head1 CONSTRUCTOR
212
213=head2 new
214
215With L<JSON::PP>, L<JSON::XS> and L<Cpanel::JSON::XS> you are required to call
216mutators to set options, such as:
217
218 my $json = $class->new->utf8(1)->pretty(1);
219
220Since this is a trifle irritating and noticeably un-perlish, we also offer:
221
222 my $json = JSON::MaybeXS->new(utf8 => 1, pretty => 1);
223
224which works equivalently to the above (and in the usual tradition will accept
225a hashref instead of a hash, should you so desire).
226
227The resulting object is blessed into the underlying backend, which offers (at
228least) the methods C<encode> and C<decode>.
229
230=head1 BOOLEANS
231
232To include JSON-aware booleans (C<true>, C<false>) in your data, just do:
233
234 use JSON::MaybeXS;
235 my $true = JSON()->true;
236 my $false = JSON()->false;
237
238The booleans are also available as subs or methods on JSON::MaybeXS.
239
240 use JSON::MaybeXS ();
241 my $true = JSON::MaybeXS::true;
242 my $true = JSON::MaybeXS->true;
243 my $false = JSON::MaybeXS::false;
244 my $false = JSON::MaybeXS->false;
245
246=head1 CONVERTING FROM JSON::Any
247
248L<JSON::Any> used to be the favoured compatibility layer above the various
249JSON backends, but over time has grown a lot of extra code to deal with legacy
250backends (e.g. L<JSON::Syck>) that are no longer needed. This is a rough guide of translating such code:
251
252Change code from:
253
254 use JSON::Any;
255 my $json = JSON::Any->new->objToJson($data); # or to_json($data), or Dump($data)
256
257to:
258
259 use JSON::MaybeXS;
260 my $json = encode_json($data);
261
262
263Change code from:
264
265 use JSON::Any;
266 my $data = JSON::Any->new->jsonToObj($json); # or from_json($json), or Load($json)
267
268to:
269
270 use JSON::MaybeXS;
271 my $json = decode_json($data);
272
273=head1 CAVEATS
274
275The C<new()> method in this module is technically a factory, not a
276constructor, because the objects it returns will I<NOT> be blessed into the
277C<JSON::MaybeXS> class.
278
279If you are using an object returned by this module as a Moo(se) attribute,
280this type constraint code:
281
282 is 'json' => ( isa => 'JSON::MaybeXS' );
283
284will I<NOT> do what you expect. Instead, either rely on the C<JSON> class
285constant described above, as so:
286
287 is 'json' => ( isa => JSON::MaybeXS::JSON() );
288
289Alternatively, you can use duck typing:
290
291 use Moose::Util::TypeConstraints 'duck_type';
292 is 'json' => ( isa => Object , duck_type([qw/ encode decode /]));
293
294=head1 INSTALLATION
295
296At installation time, F<Makefile.PL> will attempt to determine if you have a
297working compiler available, and therefore whether you are able to run XS code.
298If so, L<Cpanel::JSON::XS> will be added to the prerequisite list, unless
299L<JSON::XS> is already installed at a high enough version. L<JSON::XS> may
300also be upgraded to fix any incompatibility issues.
301
302Because running XS code is not mandatory and L<JSON::PP> (which is in perl
303core) is used as a fallback backend, this module is safe to be used in a suite
304of code that is fatpacked or installed into a restricted-resource environment.
305
306You can also prevent any XS dependencies from being installed by setting
307C<PUREPERL_ONLY=1> in F<Makefile.PL> options (or in the C<PERL_MM_OPT>
308environment variable), or using the C<--pp> or C<--pureperl> flags with the
309L<cpanminus client|cpanm>.
310
311=head1 AUTHOR
312
313mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
314
315=head1 CONTRIBUTORS
316
317=over 4
318
319=item * Clinton Gormley <drtech@cpan.org>
320
321=item * Karen Etheridge <ether@cpan.org>
322
323=item * Kieren Diment <diment@gmail.com>
324
325=back
326
327=head1 COPYRIGHT
328
329Copyright (c) 2013 the C<JSON::MaybeXS> L</AUTHOR> and L</CONTRIBUTORS>
330as listed above.
331
332=head1 LICENSE
333
334This library is free software and may be distributed under the same terms
335as perl itself.
336
337=cut