From: Kieren Diment Date: Wed, 22 Oct 2014 23:31:00 +0000 (-0700) Subject: add :legacy option (from http://paste.scsys.co.uk/433777) X-Git-Tag: v1.003_000~1^2~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ebf1e433b20d1af0e90d547f91e5eec67a0505f9;p=p5sagit%2FJSON-MaybeXS.git add :legacy option (from paste.scsys.co.uk/433777) --- diff --git a/Changes b/Changes index 2de7a32..92807d5 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,7 @@ Revision history for JSON-MaybeXS +1.003000 - 2014-10-22 + - add :legacy tag to support legacy apps 1.002006 - 2014-10-22 - add some additional test diagnostics, to help find bad version combinations of JSON backends diff --git a/lib/JSON/MaybeXS.pm b/lib/JSON/MaybeXS.pm index 69a940d..2f5abfe 100644 --- a/lib/JSON/MaybeXS.pm +++ b/lib/JSON/MaybeXS.pm @@ -2,9 +2,14 @@ package JSON::MaybeXS; use strict; use warnings FATAL => 'all'; +use Carp; use base qw(Exporter); -our $VERSION = '1.002006'; + +use YAML; + + +our $VERSION = '1.003000'; sub _choose_json_module { return 'Cpanel::JSON::XS' if $INC{'Cpanel/JSON/XS.pm'}; @@ -31,8 +36,12 @@ BEGIN { } our @EXPORT = qw(encode_json decode_json JSON); -our @EXPORT_OK = qw(is_bool); -our %EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_OK ] ); +our @EXPORT_ALL = qw/is_bool/; +our @EXPORT_OK = qw(is_bool to_json from_json); +our %EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_ALL ], + legacy => [ @EXPORT, @EXPORT_OK], + ); + sub JSON () { our $JSON_Class } @@ -54,6 +63,46 @@ sub is_bool { or $_[0]->isa('JSON::PP::Boolean')); } +# CopyPasta from JSON.pm version 2.90 + +sub from_json ($@) { + if ( ref($_[0]) eq 'JSON' or $_[0] eq 'JSON' ) { + Carp::croak "from_json should not be called as a method."; + } + my $json = JSON->new; + + if (@_ == 2 and ref $_[1] eq 'HASH') { + my $opt = $_[1]; + for my $method (keys %$opt) { + $json->$method( $opt->{$method} ); + } + } + + return $json->decode( $_[0] ); +} + +sub to_json ($@) { + if ( + ref($_[0]) eq 'JSON' + or (@_ > 2 and $_[0] eq 'JSON') + ) { + Carp::croak "to_json should not be called as a method."; + } + my $json = JSON->new; + + if (@_ == 2 and ref $_[1] eq 'HASH') { + my $opt = $_[1]; + for my $method (keys %$opt) { + $json->$method( $opt->{$method} ); + } + } + + $json->encode($_[0]); +} + + + + 1; =head1 NAME @@ -98,10 +147,22 @@ To import only some symbols, specify them on the C line: use JSON::MaybeXS qw(JSON); # JSON constant only -To import all available symbols, use C<:all>: +To import all available sensible (encode_json, decode_json and +is_bool) symbols, use C<:all>: use JSON::MaybeXS ':all'; +To import all symbols including those needed by legacy apps that use JSON::PP: + + use JSON::MaybeXS ':legacy'; + +This imports to_json and from_json symbols as well as everything in +C< :all >. NOTE: This is to support legacy code that makes extensive +use of to_json and from_json which you are not yet in a position to +refactor. DO NOT use this import tag in new code, in order to avoid +the crawling horrors of getting UTF8 support subtly wrong. See the +documentation for L for further details. + =head2 encode_json This is the C function provided by the selected implementation @@ -116,6 +177,11 @@ module, and takes a string of JSON text to deserialise to a perl data structure. my $data_structure = decode_json($json_text); +=head2 to_json, from_json + +See L< JSON > for details. These are included to support legacy code +B. + =head2 JSON The C constant returns the selected implementation module's name for diff --git a/t/legacy.t b/t/legacy.t new file mode 100644 index 0000000..0216033 --- /dev/null +++ b/t/legacy.t @@ -0,0 +1,39 @@ +use strict; +use warnings FATAL => 'all'; + +use Test::Without::Module 'Cpanel::JSON::XS'; +use Test::More; +use JSON::MaybeXS qw/:legacy/; + + + +my $in = '[1, 2, 3, 4]'; + + +my $arr = from_json($in); +my $j = to_json($arr); +is($j, '[1,2,3,4]'); +is(ref($arr), 'ARRAY'); + +done_testing; + +__END__ + + to_json + $json_text = to_json($perl_scalar) + + Converts the given Perl data structure to a json string. + + This function call is functionally identical to: + + $json_text = JSON->new->encode($perl_scalar) + + from_json + $perl_scalar = from_json($json_text) + + The opposite of "to_json": expects a json string and tries to parse it, + returning the resulting reference. + + This function call is functionally identical to: + + $perl_scalar = JSON->decode($json_text)