lib/JSON/MaybeXS.pm

   1 package JSON::MaybeXS;
   2
   3 use strict;
   4 use warnings FATAL => 'all';
   5 use base qw(Exporter);
   6
   7 our $VERSION = '1.003005';
   8 $VERSION = eval $VERSION;
   9
  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'};
  13
  14     my @err;
  15
  16     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; 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));
  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 sub JSON () { our $JSON_Class }
  42
  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
  51 use Scalar::Util ();
  52
  53 sub is_bool {
  54   die 'is_bool is not a method' if $_[1];
  55
  56   Scalar::Util::blessed($_[0])
  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 use Carp ();
  64
  65 sub from_json ($@) {
  66     if ( ref($_[0]) =~ /^JSON/ or $_[0] =~ /^JSON/ ) {
  67         Carp::croak "from_json should not be called as a method.";
  68     }
  69     my $json = JSON()->new;
  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 (
  83         ref($_[0]) =~ /^JSON/
  84         or (@_ > 2 and $_[0] =~ /^JSON/)
  85           ) {
  86                Carp::croak "to_json should not be called as a method.";
  87     }
  88     my $json = JSON()->new;
  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
 100 1;
 101
 102 =head1 NAME
 103
 104 JSON::MaybeXS - Use L<Cpanel::JSON::XS> with a fallback to L<JSON::XS> and L<JSON::PP>
 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<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.
 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
 129 If you're writing fresh code rather than replacing L<JSON.pm|JSON> usage, you might
 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
 133 =head1 EXPORTS
 134
 135 C<encode_json>, C<decode_json> and C<JSON> are exported by default; C<is_bool>
 136 is exported on request.
 137
 138 To import only some symbols, specify them on the C<use> 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<encode_json>, C<decode_json>, and
 145 C<is_bool>), use C<:all>:
 146
 147   use JSON::MaybeXS ':all';
 148
 149 To import all symbols including those needed by legacy apps that use L<JSON::PP>:
 150
 151   use JSON::MaybeXS ':legacy';
 152
 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
 156 refactor.  DO NOT use this import tag in new code, in order to avoid
 157 the crawling horrors of getting UTF8 support subtly wrong.  See the
 158 documentation for L<JSON> for further details.
 159
 160 =head2 encode_json
 161
 162 This is the C<encode_json> 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<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
 174 =head2 to_json, from_json
 175
 176 See L<JSON> for details.  These are included to support legacy code
 177 B<only>.
 178
 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
 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
 202 =head1 CONSTRUCTOR
 203
 204 =head2 new
 205
 206 With L<JSON::PP>, L<JSON::XS> and L<Cpanel::JSON::XS> 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 =head1 BOOLEANS
 219
 220 To include JSON-aware booleans (C<true>, C<false>) in your data, just do:
 221
 222     use JSON::MaybeXS;
 223     my $true = JSON->true;
 224     my $false = JSON->false;
 225
 226 =head1 CONVERTING FROM JSON::Any
 227
 228 L<JSON::Any> used to be the favoured compatibility layer above the various
 229 JSON backends, but over time has grown a lot of extra code to deal with legacy
 230 backends (e.g. L<JSON::Syck>) that are no longer needed.  This is a rough guide of translating such code:
 231
 232 Change code from:
 233
 234     use JSON::Any;
 235     my $json = JSON::Any->new->objToJson($data);    # or to_json($data), or Dump($data)
 236
 237 to:
 238
 239     use JSON::MaybeXS;
 240     my $json = encode_json($data);
 241
 242
 243 Change code from:
 244
 245     use JSON::Any;
 246     my $data = JSON::Any->new->jsonToObj($json);    # or from_json($json), or Load($json)
 247
 248 to:
 249
 250     use JSON::MaybeXS;
 251     my $json = decode_json($data);
 252
 253 =head1 CAVEATS
 254
 255 The C<new()> method in this module is technically a factory, not a
 256 constructor, because the objects it returns will I<NOT> be blessed into the
 257 C<JSON::MaybeXS> class.
 258
 259 If you are using an object returned by this module as a Moo(se) attribute,
 260 this type constraint code:
 261
 262     is 'json' => ( isa => 'JSON::MaybeXS' );
 263
 264 will I<NOT> do what you expect. Instead, either rely on the C<JSON> class
 265 constant described above, as so:
 266
 267     is 'json' => ( isa => JSON::MaybeXS::JSON() );
 268
 269 Alternatively, you can use duck typing:
 270
 271     use Moose::Util::TypeConstraints 'duck_type';
 272     is 'json' => ( isa => Object , duck_type([qw/ encode decode /]));
 273
 274 =head1 AUTHOR
 275
 276 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 277
 278 =head1 CONTRIBUTORS
 279
 280 =over 4
 281
 282 =item * Clinton Gormley <drtech@cpan.org>
 283
 284 =item * Karen Etheridge <ether@cpan.org>
 285
 286 =item * Kieren Diment <diment@gmail.com>
 287
 288 =back
 289
 290 =head1 COPYRIGHT
 291
 292 Copyright (c) 2013 the C<JSON::MaybeXS> L</AUTHOR> and L</CONTRIBUTORS>
 293 as listed above.
 294
 295 =head1 LICENSE
 296
 297 This library is free software and may be distributed under the same terms
 298 as perl itself.
 299
 300 =cut