Commit | Line | Data |
3be1e192 |
1 | package JSON::MaybeXS; |
2 | |
3 | use strict; |
4 | use warnings FATAL => 'all'; |
5 | use base qw(Exporter); |
6 | |
2e469cda |
7 | our $VERSION = '1.003006_001'; |
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 | |
114 | my $json = JSON->new; |
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 | |
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 | |
1ca3b561 |
190 | =head2 is_bool |
191 | |
192 | $is_boolean = is_bool($scalar) |
193 | |
194 | Returns true if the passed scalar represents either C<true> or |
195 | C<false>, two constants that act like C<1> and C<0>, respectively |
196 | and are used to represent JSON C<true> and C<false> 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 | |
939f9a29 |
202 | =head1 CONSTRUCTOR |
203 | |
204 | =head2 new |
205 | |
16205c4a |
206 | With L<JSON::PP>, L<JSON::XS> and L<Cpanel::JSON::XS> you are required to call |
3c38e105 |
207 | mutators to set options, such as: |
939f9a29 |
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 | |
590077bd |
218 | The resulting object is blessed into the underlying backend, which offers (at |
219 | least) the methods C<encode> and C<decode>. |
220 | |
32af371c |
221 | =head1 BOOLEANS |
222 | |
223 | To include JSON-aware booleans (C<true>, C<false>) in your data, just do: |
224 | |
225 | use JSON::MaybeXS; |
226 | my $true = JSON->true; |
227 | my $false = JSON->false; |
228 | |
61f129a5 |
229 | =head1 CONVERTING FROM JSON::Any |
230 | |
231 | L<JSON::Any> 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<JSON::Syck>) 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 | |
06551ef5 |
256 | =head1 CAVEATS |
257 | |
258 | The C<new()> method in this module is technically a factory, not a |
259 | constructor, because the objects it returns will I<NOT> be blessed into the |
260 | C<JSON::MaybeXS> 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<NOT> do what you expect. Instead, either rely on the C<JSON> class |
268 | constant described above, as so: |
269 | |
270 | is 'json' => ( isa => JSON::MaybeXS::JSON() ); |
271 | |
272 | Alternatively, you can use duck typing: |
273 | |
5bbc5b59 |
274 | use Moose::Util::TypeConstraints 'duck_type'; |
06551ef5 |
275 | is 'json' => ( isa => Object , duck_type([qw/ encode decode /])); |
276 | |
44459f01 |
277 | =head1 AUTHOR |
278 | |
279 | mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk> |
280 | |
281 | =head1 CONTRIBUTORS |
282 | |
0c45c84c |
283 | =over 4 |
284 | |
285 | =item * Clinton Gormley <drtech@cpan.org> |
286 | |
287 | =item * Karen Etheridge <ether@cpan.org> |
288 | |
c397f194 |
289 | =item * Kieren Diment <diment@gmail.com> |
290 | |
0c45c84c |
291 | =back |
44459f01 |
292 | |
293 | =head1 COPYRIGHT |
294 | |
295 | Copyright (c) 2013 the C<JSON::MaybeXS> L</AUTHOR> and L</CONTRIBUTORS> |
296 | as listed above. |
297 | |
298 | =head1 LICENSE |
299 | |
300 | This library is free software and may be distributed under the same terms |
301 | as perl itself. |
302 | |
303 | =cut |