lib/JSON/MaybeXS.pm

   1 package JSON::MaybeXS;
   2
   3 use strict;
   4 use warnings FATAL => 'all';
   5 use Carp;
   6 use base qw(Exporter);
   7
   8
   9 use YAML;
  10
  11
  12 our $VERSION = '1.003000';
  13
  14 sub _choose_json_module {
  15     return 'Cpanel::JSON::XS' if $INC{'Cpanel/JSON/XS.pm'};
  16     return 'JSON::XS'         if $INC{'JSON/XS.pm'};
  17
  18     my @err;
  19
  20     return 'Cpanel::JSON::XS' if eval { require Cpanel::JSON::XS; 1; };
  21     push @err, "Error loading Cpanel::JSON::XS: $@";
  22
  23     return 'JSON::XS' if eval { require JSON::XS; 1; };
  24     push @err, "Error loading JSON::XS: $@";
  25
  26     return 'JSON::PP' if eval { require JSON::PP; 1 };
  27     push @err, "Error loading JSON::PP: $@";
  28
  29     die join( "\n", "Couldn't load a JSON module:", @err );
  30
  31 }
  32
  33 BEGIN {
  34     our $JSON_Class = _choose_json_module();
  35     $JSON_Class->import(qw(encode_json decode_json));
  36 }
  37
  38 our @EXPORT = qw(encode_json decode_json JSON);
  39 our @EXPORT_ALL = qw/is_bool/;
  40 our @EXPORT_OK = qw(is_bool to_json from_json);
  41 our %EXPORT_TAGS = ( all    => [ @EXPORT, @EXPORT_ALL ],
  42                                         legacy => [ @EXPORT, @EXPORT_OK],
  43                                   );
  44
  45
  46 sub JSON () { our $JSON_Class }
  47
  48 sub new {
  49   shift;
  50   my %args = @_ == 1 ? %{$_[0]} : @_;
  51   my $new = (our $JSON_Class)->new;
  52   $new->$_($args{$_}) for keys %args;
  53   return $new;
  54 }
  55
  56 use Scalar::Util ();
  57
  58 sub is_bool {
  59   die 'is_bool is not a method' if $_[1];
  60
  61   Scalar::Util::blessed($_[0])
  62     and ($_[0]->isa('JSON::XS::Boolean')
  63       or $_[0]->isa('JSON::PP::Boolean'));
  64 }
  65
  66 # CopyPasta from JSON.pm version 2.90
  67
  68 sub from_json ($@) {
  69     if ( ref($_[0]) eq 'JSON' or $_[0] eq 'JSON' ) {
  70         Carp::croak "from_json should not be called as a method.";
  71     }
  72     my $json = JSON->new;
  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 (
  86         ref($_[0]) eq 'JSON'
  87         or (@_ > 2 and $_[0] eq 'JSON')
  88           ) {
  89                Carp::croak "to_json should not be called as a method.";
  90     }
  91     my $json = JSON->new;
  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
 103
 104
 105
 106 1;
 107
 108 =head1 NAME
 109
 110 JSON::MaybeXS - Use L<Cpanel::JSON::XS> with a fallback to L<JSON::XS> and L<JSON::PP>
 111
 112 =head1 SYNOPSIS
 113
 114   use JSON::MaybeXS;
 115
 116   my $data_structure = decode_json($json_input);
 117
 118   my $json_output = encode_json($data_structure);
 119
 120   my $json = JSON->new;
 121
 122   my $json_with_args = JSON::MaybeXS->new(utf8 => 1); # or { utf8 => 1 }
 123
 124 =head1 DESCRIPTION
 125
 126 This module first checks to see if either L<Cpanel::JSON::XS> or
 127 L<JSON::XS> is already loaded, in which case it uses that module. Otherwise
 128 it tries to load L<Cpanel::JSON::XS>, then L<JSON::XS>, then L<JSON::PP>
 129 in order, and either uses the first module it finds or throws an error.
 130
 131 It then exports the C<encode_json> and C<decode_json> functions from the
 132 loaded module, along with a C<JSON> constant that returns the class name
 133 for calling C<new> on.
 134
 135 If you're writing fresh code rather than replacing L<JSON.pm|JSON> usage, you might
 136 want to pass options as constructor args rather than calling mutators, so
 137 we provide our own C<new> method that supports that.
 138
 139 =head1 EXPORTS
 140
 141 C<encode_json>, C<decode_json> and C<JSON> are exported by default; C<is_bool>
 142 is exported on request.
 143
 144 To import only some symbols, specify them on the C<use> line:
 145
 146   use JSON::MaybeXS qw(encode_json decode_json is_bool); # functions only
 147
 148   use JSON::MaybeXS qw(JSON); # JSON constant only
 149
 150 To import all available sensible (encode_json, decode_json and
 151 is_bool) symbols, use C<:all>:
 152
 153   use JSON::MaybeXS ':all';
 154
 155 To import all symbols including those needed by legacy apps that use JSON::PP:
 156
 157   use JSON::MaybeXS ':legacy';
 158
 159 This imports to_json and from_json symbols as well as everything in
 160 C< :all >.  NOTE: This is to support legacy code that makes extensive
 161 use of to_json and from_json which you are not yet in a position to
 162 refactor.  DO NOT use this import tag in new code, in order to avoid
 163 the crawling horrors of getting UTF8 support subtly wrong.  See the
 164 documentation for L<JSON> for further details.
 165
 166 =head2 encode_json
 167
 168 This is the C<encode_json> function provided by the selected implementation
 169 module, and takes a perl data structure which is serialised to JSON text.
 170
 171   my $json_text = encode_json($data_structure);
 172
 173 =head2 decode_json
 174
 175 This is the C<decode_json> function provided by the selected implementation
 176 module, and takes a string of JSON text to deserialise to a perl data structure.
 177
 178   my $data_structure = decode_json($json_text);
 179
 180 =head2 to_json, from_json
 181
 182 See L< JSON > for details.  These are included to support legacy code
 183 B<only>.
 184
 185 =head2 JSON
 186
 187 The C<JSON> constant returns the selected implementation module's name for
 188 use as a class name - so:
 189
 190   my $json_obj = JSON->new; # returns a Cpanel::JSON::XS or JSON::PP object
 191
 192 and that object can then be used normally:
 193
 194   my $data_structure = $json_obj->decode($json_text); # etc.
 195
 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
 208 =head1 CONSTRUCTOR
 209
 210 =head2 new
 211
 212 With L<JSON::PP>, L<JSON::XS> and L<Cpanel::JSON::XS> you are required to call
 213 mutators to set options, such as:
 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
 224 =head1 BOOLEANS
 225
 226 To include JSON-aware booleans (C<true>, C<false>) in your data, just do:
 227
 228     use JSON::MaybeXS;
 229     my $true = JSON->true;
 230     my $false = JSON->false;
 231
 232 =head1 AUTHOR
 233
 234 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 235
 236 =head1 CONTRIBUTORS
 237
 238 =over 4
 239
 240 =item * Clinton Gormley <drtech@cpan.org>
 241
 242 =item * Karen Etheridge <ether@cpan.org>
 243
 244 =back
 245
 246 =head1 COPYRIGHT
 247
 248 Copyright (c) 2013 the C<JSON::MaybeXS> L</AUTHOR> and L</CONTRIBUTORS>
 249 as listed above.
 250
 251 =head1 LICENSE
 252
 253 This library is free software and may be distributed under the same terms
 254 as perl itself.
 255
 256 =cut