Filename | /Users/ether/.perlbrew/libs/36.0@std/lib/perl5/JSON/MaybeXS.pm |
Statements | Executed 116427 statements in 233ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
58197 | 2 | 1 | 175ms | 212ms | is_bool | JSON::MaybeXS::
1 | 1 | 1 | 3.32ms | 10.2ms | _choose_json_module | JSON::MaybeXS::
1 | 1 | 1 | 2.07ms | 2.18ms | BEGIN@5 | JSON::MaybeXS::
1 | 1 | 1 | 30µs | 10.3ms | BEGIN@29 | JSON::MaybeXS::
1 | 1 | 1 | 24µs | 26µs | BEGIN@3 | JSON::MaybeXS::
1 | 1 | 1 | 24µs | 35µs | new | JSON::MaybeXS::
1 | 1 | 1 | 8µs | 16µs | BEGIN@32 | JSON::MaybeXS::
1 | 1 | 1 | 5µs | 41µs | BEGIN@4 | JSON::MaybeXS::
1 | 1 | 1 | 5µs | 5µs | BEGIN@54 | JSON::MaybeXS::
1 | 1 | 1 | 3µs | 3µs | BEGIN@66 | JSON::MaybeXS::
0 | 0 | 0 | 0s | 0s | JSON | JSON::MaybeXS::
0 | 0 | 0 | 0s | 0s | from_json | JSON::MaybeXS::
0 | 0 | 0 | 0s | 0s | to_json | JSON::MaybeXS::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package JSON::MaybeXS; | ||||
2 | |||||
3 | 2 | 35µs | 2 | 28µ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 # spent 26µs making 1 call to JSON::MaybeXS::BEGIN@3
# spent 2µs making 1 call to strict::import |
4 | 2 | 22µs | 2 | 77µ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 # spent 41µs making 1 call to JSON::MaybeXS::BEGIN@4
# spent 36µs making 1 call to warnings::import |
5 | 2 | 744µs | 2 | 2.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 # spent 2.18ms making 1 call to JSON::MaybeXS::BEGIN@5
# spent 70µs making 1 call to base::import |
6 | |||||
7 | 1 | 0s | our $VERSION = '1.004004'; | ||
8 | 1 | 1µ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 | ||||
11 | 1 | 0s | return 'Cpanel::JSON::XS' if $INC{'Cpanel/JSON/XS.pm'}; | ||
12 | 1 | 0s | return 'JSON::XS' if $INC{'JSON/XS.pm'} && eval { JSON::XS->VERSION(3.0); 1 }; | ||
13 | |||||
14 | 1 | 0s | my @err; | ||
15 | |||||
16 | 3 | 794µ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 | ||||
30 | 1 | 1µs | 1 | 10.2ms | our $JSON_Class = _choose_json_module(); # spent 10.2ms making 1 call to JSON::MaybeXS::_choose_json_module |
31 | 1 | 4µs | 1 | 48µs | $JSON_Class->import(qw(encode_json decode_json)); # spent 48µs making 1 call to Exporter::import |
32 | 2 | 45µs | 2 | 24µ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 # spent 16µs making 1 call to JSON::MaybeXS::BEGIN@32
# spent 8µs making 1 call to strict::unimport |
33 | *$_ = $JSON_Class->can($_) | ||||
34 | 1 | 14µs | 2 | 2µs | for qw(true false); # spent 2µs making 2 calls to UNIVERSAL::can, avg 1µs/call |
35 | 1 | 237µs | 1 | 10.3ms | } # spent 10.3ms making 1 call to JSON::MaybeXS::BEGIN@29 |
36 | |||||
37 | 1 | 1µs | our @EXPORT = qw(encode_json decode_json JSON); | ||
38 | 1 | 1µs | my @EXPORT_ALL = qw(is_bool); | ||
39 | 1 | 0s | our @EXPORT_OK = qw(is_bool to_json from_json); | ||
40 | 1 | 4µs | our %EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_ALL ], | ||
41 | legacy => [ @EXPORT, @EXPORT_OK ], | ||||
42 | ); | ||||
43 | |||||
44 | sub 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 | ||||
47 | 1 | 0s | shift; | ||
48 | 1 | 2µs | my %args = @_ == 1 ? %{$_[0]} : @_; | ||
49 | 1 | 13µs | 1 | 9µs | my $new = (our $JSON_Class)->new; # spent 9µs making 1 call to Cpanel::JSON::XS::new |
50 | 1 | 18µs | 5 | 2µ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 |
51 | 1 | 4µs | return $new; | ||
52 | } | ||||
53 | |||||
54 | 2 | 84µs | 1 | 5µ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 # 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 | ||||
57 | 58197 | 10.5ms | die 'is_bool is not a method' if $_[1]; | ||
58 | |||||
59 | 58197 | 219ms | 64583 | 36.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 | ||||
66 | 2 | 782µs | 1 | 3µ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 # spent 3µs making 1 call to JSON::MaybeXS::BEGIN@66 |
67 | |||||
68 | sub 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 | |||||
84 | sub 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 | |||||
103 | 1 | 13µs | 1; | ||
104 | |||||
105 | =head1 NAME | ||||
106 | |||||
107 | JSON::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 | |||||
123 | This module first checks to see if either L<Cpanel::JSON::XS> or | ||||
124 | L<JSON::XS> (at at least version 3.0) | ||||
125 | is already loaded, in which case it uses that module. Otherwise | ||||
126 | it tries to load L<Cpanel::JSON::XS>, then L<JSON::XS>, then L<JSON::PP> | ||||
127 | in order, and either uses the first module it finds or throws an error. | ||||
128 | |||||
129 | It then exports the C<encode_json> and C<decode_json> functions from the | ||||
130 | loaded module, along with a C<JSON> constant that returns the class name | ||||
131 | for calling C<new> on. | ||||
132 | |||||
133 | If you're writing fresh code rather than replacing L<JSON.pm|JSON> usage, you might | ||||
134 | want to pass options as constructor args rather than calling mutators, so | ||||
135 | we provide our own C<new> method that supports that. | ||||
136 | |||||
137 | =head1 EXPORTS | ||||
138 | |||||
139 | C<encode_json>, C<decode_json> and C<JSON> are exported by default; C<is_bool> | ||||
140 | is exported on request. | ||||
141 | |||||
142 | To 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 | |||||
148 | To import all available sensible symbols (C<encode_json>, C<decode_json>, and | ||||
149 | C<is_bool>), use C<:all>: | ||||
150 | |||||
151 | use JSON::MaybeXS ':all'; | ||||
152 | |||||
153 | To import all symbols including those needed by legacy apps that use L<JSON::PP>: | ||||
154 | |||||
155 | use JSON::MaybeXS ':legacy'; | ||||
156 | |||||
157 | This imports the C<to_json> and C<from_json> symbols as well as everything in | ||||
158 | C<:all>. NOTE: This is to support legacy code that makes extensive | ||||
159 | use of C<to_json> and C<from_json> which you are not yet in a position to | ||||
160 | refactor. DO NOT use this import tag in new code, in order to avoid | ||||
161 | the crawling horrors of getting UTF-8 support subtly wrong. See the | ||||
162 | documentation for L<JSON> for further details. | ||||
163 | |||||
164 | =head2 encode_json | ||||
165 | |||||
166 | This is the C<encode_json> function provided by the selected implementation | ||||
167 | module, 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 | |||||
173 | This is the C<decode_json> function provided by the selected implementation | ||||
174 | module, 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 | |||||
180 | See L<JSON> for details. These are included to support legacy code | ||||
181 | B<only>. | ||||
182 | |||||
183 | =head2 JSON | ||||
184 | |||||
185 | The C<JSON> constant returns the selected implementation module's name for | ||||
186 | use as a class name - so: | ||||
187 | |||||
188 | my $json_obj = JSON()->new; # returns a Cpanel::JSON::XS or JSON::PP object | ||||
189 | |||||
190 | and that object can then be used normally: | ||||
191 | |||||
192 | my $data_structure = $json_obj->decode($json_text); # etc. | ||||
193 | |||||
194 | The use of parentheses here is optional, and only used as a hint to the reader | ||||
195 | that 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 | |||||
201 | Returns true if the passed scalar represents either C<true> or | ||||
202 | C<false>, two constants that act like C<1> and C<0>, respectively | ||||
203 | and are used to represent JSON C<true> and C<false> values in Perl. | ||||
204 | |||||
205 | Since this is a bare sub in the various backend classes, it cannot be called as | ||||
206 | a class method like the other interfaces; it must be called as a function, with | ||||
207 | no invocant. It supports the representation used in all JSON backends. | ||||
208 | |||||
209 | Available since version 1.002004. | ||||
210 | |||||
211 | =head1 CONSTRUCTOR | ||||
212 | |||||
213 | =head2 new | ||||
214 | |||||
215 | With L<JSON::PP>, L<JSON::XS> and L<Cpanel::JSON::XS> you are required to call | ||||
216 | mutators to set options, such as: | ||||
217 | |||||
218 | my $json = $class->new->utf8(1)->pretty(1); | ||||
219 | |||||
220 | Since this is a trifle irritating and noticeably un-perlish, we also offer: | ||||
221 | |||||
222 | my $json = JSON::MaybeXS->new(utf8 => 1, pretty => 1); | ||||
223 | |||||
224 | which works equivalently to the above (and in the usual tradition will accept | ||||
225 | a hashref instead of a hash, should you so desire). | ||||
226 | |||||
227 | The resulting object is blessed into the underlying backend, which offers (at | ||||
228 | least) the methods C<encode> and C<decode>. | ||||
229 | |||||
230 | =head1 BOOLEANS | ||||
231 | |||||
232 | To 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 | |||||
238 | The 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 | |||||
248 | L<JSON::Any> used to be the favoured compatibility layer above the various | ||||
249 | JSON backends, but over time has grown a lot of extra code to deal with legacy | ||||
250 | backends (e.g. L<JSON::Syck>) that are no longer needed. This is a rough guide of translating such code: | ||||
251 | |||||
252 | Change code from: | ||||
253 | |||||
254 | use JSON::Any; | ||||
255 | my $json = JSON::Any->new->objToJson($data); # or to_json($data), or Dump($data) | ||||
256 | |||||
257 | to: | ||||
258 | |||||
259 | use JSON::MaybeXS; | ||||
260 | my $json = encode_json($data); | ||||
261 | |||||
262 | |||||
263 | Change code from: | ||||
264 | |||||
265 | use JSON::Any; | ||||
266 | my $data = JSON::Any->new->jsonToObj($json); # or from_json($json), or Load($json) | ||||
267 | |||||
268 | to: | ||||
269 | |||||
270 | use JSON::MaybeXS; | ||||
271 | my $json = decode_json($data); | ||||
272 | |||||
273 | =head1 CAVEATS | ||||
274 | |||||
275 | The C<new()> method in this module is technically a factory, not a | ||||
276 | constructor, because the objects it returns will I<NOT> be blessed into the | ||||
277 | C<JSON::MaybeXS> class. | ||||
278 | |||||
279 | If you are using an object returned by this module as a Moo(se) attribute, | ||||
280 | this type constraint code: | ||||
281 | |||||
282 | is 'json' => ( isa => 'JSON::MaybeXS' ); | ||||
283 | |||||
284 | will I<NOT> do what you expect. Instead, either rely on the C<JSON> class | ||||
285 | constant described above, as so: | ||||
286 | |||||
287 | is 'json' => ( isa => JSON::MaybeXS::JSON() ); | ||||
288 | |||||
289 | Alternatively, 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 | |||||
296 | At installation time, F<Makefile.PL> will attempt to determine if you have a | ||||
297 | working compiler available, and therefore whether you are able to run XS code. | ||||
298 | If so, L<Cpanel::JSON::XS> will be added to the prerequisite list, unless | ||||
299 | L<JSON::XS> is already installed at a high enough version. L<JSON::XS> may | ||||
300 | also be upgraded to fix any incompatibility issues. | ||||
301 | |||||
302 | Because running XS code is not mandatory and L<JSON::PP> (which is in perl | ||||
303 | core) is used as a fallback backend, this module is safe to be used in a suite | ||||
304 | of code that is fatpacked or installed into a restricted-resource environment. | ||||
305 | |||||
306 | You can also prevent any XS dependencies from being installed by setting | ||||
307 | C<PUREPERL_ONLY=1> in F<Makefile.PL> options (or in the C<PERL_MM_OPT> | ||||
308 | environment variable), or using the C<--pp> or C<--pureperl> flags with the | ||||
309 | L<cpanminus client|cpanm>. | ||||
310 | |||||
311 | =head1 AUTHOR | ||||
312 | |||||
313 | mst - 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 | |||||
329 | Copyright (c) 2013 the C<JSON::MaybeXS> L</AUTHOR> and L</CONTRIBUTORS> | ||||
330 | as listed above. | ||||
331 | |||||
332 | =head1 LICENSE | ||||
333 | |||||
334 | This library is free software and may be distributed under the same terms | ||||
335 | as perl itself. | ||||
336 | |||||
337 | =cut |