File Coverage

blib/lib/JSON/MaybeXS.pm
Criterion Covered Total %
statement 51 58 87.9
branch 19 24 79.1
condition 11 21 52.3
subroutine 12 12 100.0
pod 5 5 100.0
total 98 120 81.6


line stmt bran cond sub pod time code
1             package JSON::MaybeXS;
2              
3 7     7   100647 use strict;
  7         10  
  7         200  
4 7     7   27 use warnings FATAL => 'all';
  7         9  
  7         343  
5 7     7   633 use base qw(Exporter);
  7         11  
  7         1575  
6              
7             our $VERSION = '1.003008';
8             $VERSION = eval $VERSION;
9              
10             sub _choose_json_module {
11 7 100   7   26 return 'Cpanel::JSON::XS' if $INC{'Cpanel/JSON/XS.pm'};
12 6 50       13 return 'JSON::XS' if $INC{'JSON/XS.pm'};
13              
14 6         8 my @err;
15              
16 6 100       14 return 'Cpanel::JSON::XS' if eval { require Cpanel::JSON::XS; 1; };
  6         1390  
  2         8434  
17 4         2503 push @err, "Error loading Cpanel::JSON::XS: $@";
18              
19 4 50       5 return 'JSON::XS' if eval { require JSON::XS; 1; };
  4         23  
  0         0  
20 4         446 push @err, "Error loading JSON::XS: $@";
21              
22 4 100       4 return 'JSON::PP' if eval { require JSON::PP; 1 };
  4         21  
  3         24994  
23 1         2 push @err, "Error loading JSON::PP: $@";
24              
25 1         21 die join( "\n", "Couldn't load a JSON module:", @err );
26              
27             }
28              
29             BEGIN {
30 7     7   16 our $JSON_Class = _choose_json_module();
31 6         1128 $JSON_Class->import(qw(encode_json decode_json));
32             }
33              
34             our @EXPORT = qw(encode_json decode_json JSON);
35             my @EXPORT_ALL = qw(is_bool);
36             our @EXPORT_OK = qw(is_bool to_json from_json);
37             our %EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_ALL ],
38             legacy => [ @EXPORT, @EXPORT_OK ],
39             );
40              
41 14     14 1 587 sub JSON () { our $JSON_Class }
42              
43             sub new {
44 5     5 1 1731 shift;
45 5 100       22 my %args = @_ == 1 ? %{$_[0]} : @_;
  1         3  
46 5         39 my $new = (our $JSON_Class)->new;
47 5         29 $new->$_($args{$_}) for keys %args;
48 5         40 return $new;
49             }
50              
51 6     6   29 use Scalar::Util ();
  6         7  
  6         386  
52              
53             sub is_bool {
54 9 50   9 1 15985 die 'is_bool is not a method' if $_[1];
55              
56 9 100 66     141 Scalar::Util::blessed($_[0])
      66        
57             and ($_[0]->isa('JSON::XS::Boolean')
58             or $_[0]->isa('Cpanel::JSON::XS::Boolean')
59             or $_[0]->isa('JSON::PP::Boolean'));
60             }
61              
62             # (mostly) CopyPasta from JSON.pm version 2.90
63 6     6   23 use Carp ();
  6         31  
  6         1672  
64              
65             sub from_json ($@) {
66 2 100 66 2 1 970 if ( ref($_[0]) =~ /^JSON/ or $_[0] =~ /^JSON/ ) {
67 1         182 Carp::croak "from_json should not be called as a method.";
68             }
69 1         4 my $json = JSON()->new;
70              
71 1 50 33     16 if (@_ == 2 and ref $_[1] eq 'HASH') {
72 0         0 my $opt = $_[1];
73 0         0 for my $method (keys %$opt) {
74 0         0 $json->$method( $opt->{$method} );
75             }
76             }
77              
78 1         5 return $json->decode( $_[0] );
79             }
80              
81             sub to_json ($@) {
82 2 100 66 2 1 572 if (
      33        
83             ref($_[0]) =~ /^JSON/
84             or (@_ > 2 and $_[0] =~ /^JSON/)
85             ) {
86 1         119 Carp::croak "to_json should not be called as a method.";
87             }
88 1         2 my $json = JSON()->new;
89              
90 1 50 33     11 if (@_ == 2 and ref $_[1] eq 'HASH') {
91 0         0 my $opt = $_[1];
92 0         0 for my $method (keys %$opt) {
93 0         0 $json->$method( $opt->{$method} );
94             }
95             }
96              
97 1         4 $json->encode($_[0]);
98             }
99              
100             1;
101              
102             =head1 NAME
103              
104             JSON::MaybeXS - Use L with a fallback to L and L
105              
106             =head1 SYNOPSIS
107              
108             use JSON::MaybeXS;
109              
110             my $data_structure = decode_json($json_input);
111              
112             my $json_output = encode_json($data_structure);
113              
114             my $json = JSON->new;
115              
116             my $json_with_args = JSON::MaybeXS->new(utf8 => 1); # or { utf8 => 1 }
117              
118             =head1 DESCRIPTION
119              
120             This module first checks to see if either L or
121             L is already loaded, in which case it uses that module. Otherwise
122             it tries to load L, then L, then L
123             in order, and either uses the first module it finds or throws an error.
124              
125             It then exports the C and C functions from the
126             loaded module, along with a C constant that returns the class name
127             for calling C on.
128              
129             If you're writing fresh code rather than replacing L usage, you might
130             want to pass options as constructor args rather than calling mutators, so
131             we provide our own C method that supports that.
132              
133             =head1 EXPORTS
134              
135             C, C and C are exported by default; C
136             is exported on request.
137              
138             To import only some symbols, specify them on the C line:
139              
140             use JSON::MaybeXS qw(encode_json decode_json is_bool); # functions only
141              
142             use JSON::MaybeXS qw(JSON); # JSON constant only
143              
144             To import all available sensible symbols (C, C, and
145             C), use C<:all>:
146              
147             use JSON::MaybeXS ':all';
148              
149             To import all symbols including those needed by legacy apps that use L:
150              
151             use JSON::MaybeXS ':legacy';
152              
153             This imports the C and C symbols as well as everything in
154             C<:all>. NOTE: This is to support legacy code that makes extensive
155             use of C and C which you are not yet in a position to
156             refactor. DO NOT use this import tag in new code, in order to avoid
157             the crawling horrors of getting UTF-8 support subtly wrong. See the
158             documentation for L for further details.
159              
160             =head2 encode_json
161              
162             This is the C function provided by the selected implementation
163             module, and takes a perl data structure which is serialised to JSON text.
164              
165             my $json_text = encode_json($data_structure);
166              
167             =head2 decode_json
168              
169             This is the C function provided by the selected implementation
170             module, and takes a string of JSON text to deserialise to a perl data structure.
171              
172             my $data_structure = decode_json($json_text);
173              
174             =head2 to_json, from_json
175              
176             See L for details. These are included to support legacy code
177             B.
178              
179             =head2 JSON
180              
181             The C constant returns the selected implementation module's name for
182             use as a class name - so:
183              
184             my $json_obj = JSON->new; # returns a Cpanel::JSON::XS or JSON::PP object
185              
186             and that object can then be used normally:
187              
188             my $data_structure = $json_obj->decode($json_text); # etc.
189              
190             =head2 is_bool
191              
192             $is_boolean = is_bool($scalar)
193              
194             Returns true if the passed scalar represents either C or
195             C, two constants that act like C<1> and C<0>, respectively
196             and are used to represent JSON C and C values in Perl.
197              
198             Since this is a bare sub in the various backend classes, it cannot be called as
199             a class method like the other interfaces; it must be called as a function, with
200             no invocant. It supports the representation used in all JSON backends.
201              
202             =head1 CONSTRUCTOR
203              
204             =head2 new
205              
206             With L, L and L you are required to call
207             mutators to set options, such as:
208              
209             my $json = $class->new->utf8(1)->pretty(1);
210              
211             Since this is a trifle irritating and noticeably un-perlish, we also offer:
212              
213             my $json = JSON::MaybeXS->new(utf8 => 1, pretty => 1);
214              
215             which works equivalently to the above (and in the usual tradition will accept
216             a hashref instead of a hash, should you so desire).
217              
218             The resulting object is blessed into the underlying backend, which offers (at
219             least) the methods C and C.
220              
221             =head1 BOOLEANS
222              
223             To include JSON-aware booleans (C, C) in your data, just do:
224              
225             use JSON::MaybeXS;
226             my $true = JSON->true;
227             my $false = JSON->false;
228              
229             =head1 CONVERTING FROM JSON::Any
230              
231             L used to be the favoured compatibility layer above the various
232             JSON backends, but over time has grown a lot of extra code to deal with legacy
233             backends (e.g. L) that are no longer needed. This is a rough guide of translating such code:
234              
235             Change code from:
236              
237             use JSON::Any;
238             my $json = JSON::Any->new->objToJson($data); # or to_json($data), or Dump($data)
239              
240             to:
241              
242             use JSON::MaybeXS;
243             my $json = encode_json($data);
244              
245              
246             Change code from:
247              
248             use JSON::Any;
249             my $data = JSON::Any->new->jsonToObj($json); # or from_json($json), or Load($json)
250              
251             to:
252              
253             use JSON::MaybeXS;
254             my $json = decode_json($data);
255              
256             =head1 CAVEATS
257              
258             The C method in this module is technically a factory, not a
259             constructor, because the objects it returns will I be blessed into the
260             C class.
261              
262             If you are using an object returned by this module as a Moo(se) attribute,
263             this type constraint code:
264              
265             is 'json' => ( isa => 'JSON::MaybeXS' );
266              
267             will I do what you expect. Instead, either rely on the C class
268             constant described above, as so:
269              
270             is 'json' => ( isa => JSON::MaybeXS::JSON() );
271              
272             Alternatively, you can use duck typing:
273              
274             use Moose::Util::TypeConstraints 'duck_type';
275             is 'json' => ( isa => Object , duck_type([qw/ encode decode /]));
276              
277             =head1 INSTALLATION
278              
279             At installation time, F will attempt to determine if you have a
280             working compiler available, and therefore whether you are able to run XS code.
281             If so, L will be added to the prerequisite list, unless
282             L is already installed at a high enough version. L may
283             also be upgraded to fix any incompatibility issues.
284              
285             Because running XS code is not mandatory and L (which is in perl
286             core) is used as a fallback backend, this module is safe to be used in a suite
287             of code that is fatpacked or installed into a restricted-resource environment.
288              
289             You can also prevent any XS dependencies from being installed by setting
290             C in F options (or in the C
291             environment variable), or using the C<--pp> or C<--pureperl> flags with the
292             L.
293              
294             =head1 AUTHOR
295              
296             mst - Matt S. Trout (cpan:MSTROUT)
297              
298             =head1 CONTRIBUTORS
299              
300             =over 4
301              
302             =item * Clinton Gormley
303              
304             =item * Karen Etheridge
305              
306             =item * Kieren Diment
307              
308             =back
309              
310             =head1 COPYRIGHT
311              
312             Copyright (c) 2013 the C L and L
313             as listed above.
314              
315             =head1 LICENSE
316              
317             This library is free software and may be distributed under the same terms
318             as perl itself.
319              
320             =cut