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.003_000';   # TRIAL RELEASE
   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('JSON::PP::Boolean'));
  59 }
  60
  61 # (mostly) CopyPasta from JSON.pm version 2.90
  62 use Carp ();
  63
  64 sub from_json ($@) {
  65     if ( ref($_[0]) =~ /^JSON/ or $_[0] =~ /^JSON/ ) {
  66         Carp::croak "from_json should not be called as a method.";
  67     }
  68     my $json = JSON()->new;
  69
  70     if (@_ == 2 and ref $_[1] eq 'HASH') {
  71         my $opt  = $_[1];
  72         for my $method (keys %$opt) {
  73             $json->$method( $opt->{$method} );
  74         }
  75     }
  76
  77     return $json->decode( $_[0] );
  78 }
  79
  80 sub to_json ($@) {
  81     if (
  82         ref($_[0]) =~ /^JSON/
  83         or (@_ > 2 and $_[0] =~ /^JSON/)
  84           ) {
  85                Carp::croak "to_json should not be called as a method.";
  86     }
  87     my $json = JSON()->new;
  88
  89     if (@_ == 2 and ref $_[1] eq 'HASH') {
  90         my $opt  = $_[1];
  91         for my $method (keys %$opt) {
  92             $json->$method( $opt->{$method} );
  93         }
  94     }
  95
  96     $json->encode($_[0]);
  97 }
  98
  99 1;
 100
 101 =head1 NAME
 102
 103 JSON::MaybeXS - Use L<Cpanel::JSON::XS> with a fallback to L<JSON::XS> and L<JSON::PP>
 104
 105 =head1 SYNOPSIS
 106
 107   use JSON::MaybeXS;
 108
 109   my $data_structure = decode_json($json_input);
 110
 111   my $json_output = encode_json($data_structure);
 112
 113   my $json = JSON->new;
 114
 115   my $json_with_args = JSON::MaybeXS->new(utf8 => 1); # or { utf8 => 1 }
 116
 117 =head1 DESCRIPTION
 118
 119 This module first checks to see if either L<Cpanel::JSON::XS> or
 120 L<JSON::XS> is already loaded, in which case it uses that module. Otherwise
 121 it tries to load L<Cpanel::JSON::XS>, then L<JSON::XS>, then L<JSON::PP>
 122 in order, and either uses the first module it finds or throws an error.
 123
 124 It then exports the C<encode_json> and C<decode_json> functions from the
 125 loaded module, along with a C<JSON> constant that returns the class name
 126 for calling C<new> on.
 127
 128 If you're writing fresh code rather than replacing L<JSON.pm|JSON> usage, you might
 129 want to pass options as constructor args rather than calling mutators, so
 130 we provide our own C<new> method that supports that.
 131
 132 =head1 EXPORTS
 133
 134 C<encode_json>, C<decode_json> and C<JSON> are exported by default; C<is_bool>
 135 is exported on request.
 136
 137 To import only some symbols, specify them on the C<use> line:
 138
 139   use JSON::MaybeXS qw(encode_json decode_json is_bool); # functions only
 140
 141   use JSON::MaybeXS qw(JSON); # JSON constant only
 142
 143 To import all available sensible symbols (C<encode_json>, C<decode_json>, and
 144 C<is_bool>), use C<:all>:
 145
 146   use JSON::MaybeXS ':all';
 147
 148 To import all symbols including those needed by legacy apps that use L<JSON::PP>:
 149
 150   use JSON::MaybeXS ':legacy';
 151
 152 This imports the C<to_json> and C<from_json> symbols as well as everything in
 153 C<:all>.  NOTE: This is to support legacy code that makes extensive
 154 use of C<to_json> and C<from_json> which you are not yet in a position to
 155 refactor.  DO NOT use this import tag in new code, in order to avoid
 156 the crawling horrors of getting UTF8 support subtly wrong.  See the
 157 documentation for L<JSON> for further details.
 158
 159 =head2 encode_json
 160
 161 This is the C<encode_json> function provided by the selected implementation
 162 module, and takes a perl data structure which is serialised to JSON text.
 163
 164   my $json_text = encode_json($data_structure);
 165
 166 =head2 decode_json
 167
 168 This is the C<decode_json> function provided by the selected implementation
 169 module, and takes a string of JSON text to deserialise to a perl data structure.
 170
 171   my $data_structure = decode_json($json_text);
 172
 173 =head2 to_json, from_json
 174
 175 See L<JSON> for details.  These are included to support legacy code
 176 B<only>.
 177
 178 =head2 JSON
 179
 180 The C<JSON> constant returns the selected implementation module's name for
 181 use as a class name - so:
 182
 183   my $json_obj = JSON->new; # returns a Cpanel::JSON::XS or JSON::PP object
 184
 185 and that object can then be used normally:
 186
 187   my $data_structure = $json_obj->decode($json_text); # etc.
 188
 189 =head2 is_bool
 190
 191   $is_boolean = is_bool($scalar)
 192
 193 Returns true if the passed scalar represents either C<true> or
 194 C<false>, two constants that act like C<1> and C<0>, respectively
 195 and are used to represent JSON C<true> and C<false> values in Perl.
 196
 197 Since this is a bare sub in the various backend classes, it cannot be called as
 198 a class method like the other interfaces; it must be called as a function, with
 199 no invocant.  It supports the representation used in all JSON backends.
 200
 201 =head1 CONSTRUCTOR
 202
 203 =head2 new
 204
 205 With L<JSON::PP>, L<JSON::XS> and L<Cpanel::JSON::XS> you are required to call
 206 mutators to set options, such as:
 207
 208   my $json = $class->new->utf8(1)->pretty(1);
 209
 210 Since this is a trifle irritating and noticeably un-perlish, we also offer:
 211
 212   my $json = JSON::MaybeXS->new(utf8 => 1, pretty => 1);
 213
 214 which works equivalently to the above (and in the usual tradition will accept
 215 a hashref instead of a hash, should you so desire).
 216
 217 =head1 BOOLEANS
 218
 219 To include JSON-aware booleans (C<true>, C<false>) in your data, just do:
 220
 221     use JSON::MaybeXS;
 222     my $true = JSON->true;
 223     my $false = JSON->false;
 224
 225 =head1 AUTHOR
 226
 227 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 228
 229 =head1 CONTRIBUTORS
 230
 231 =over 4
 232
 233 =item * Clinton Gormley <drtech@cpan.org>
 234
 235 =item * Karen Etheridge <ether@cpan.org>
 236
 237 =item * Kieren Diment <diment@gmail.com>
 238
 239 =back
 240
 241 =head1 COPYRIGHT
 242
 243 Copyright (c) 2013 the C<JSON::MaybeXS> L</AUTHOR> and L</CONTRIBUTORS>
 244 as listed above.
 245
 246 =head1 LICENSE
 247
 248 This library is free software and may be distributed under the same terms
 249 as perl itself.
 250
 251 =cut