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.003001';
   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::PP::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 AUTHOR
 227
 228 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 229
 230 =head1 CONTRIBUTORS
 231
 232 =over 4
 233
 234 =item * Clinton Gormley <drtech@cpan.org>
 235
 236 =item * Karen Etheridge <ether@cpan.org>
 237
 238 =item * Kieren Diment <diment@gmail.com>
 239
 240 =back
 241
 242 =head1 COPYRIGHT
 243
 244 Copyright (c) 2013 the C<JSON::MaybeXS> L</AUTHOR> and L</CONTRIBUTORS>
 245 as listed above.
 246
 247 =head1 LICENSE
 248
 249 This library is free software and may be distributed under the same terms
 250 as perl itself.
 251
 252 =cut