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