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