From 2361260e8d4c84ce6ab43f225322b28a8e4e4391 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Mon, 4 Feb 2019 16:14:30 +0100
Subject: [PATCH] Disable allow_nonref in JSON::XS 4 and JSON:PP 3
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This patch disables allow_nonref feature in JSON::XS >= 4 and JSON::PP >= 3.
The reason is to provide a uniform behavior including backends that
do not support it.

<https://github.com/karenetheridge/JSON-Any/pull/2>

Signed-off-by: Petr Písař <ppisar@redhat.com>
---
 lib/JSON/Any.pm     | 19 ++++++++++++++----
 t/15-allow_nonref.t | 48 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 63 insertions(+), 4 deletions(-)
 create mode 100644 t/15-allow_nonref.t

diff --git a/lib/JSON/Any.pm b/lib/JSON/Any.pm
index 11a4928..b47ca3a 100644
--- a/lib/JSON/Any.pm
+++ b/lib/JSON/Any.pm
@@ -207,9 +207,17 @@ BEGIN {
     );
 
     # JSON::PP has the same API as JSON.pm v2
-    $conf{json_pp} = { %{ $conf{json_2} } };
-    $conf{json_pp}{get_true}  = sub { return JSON::PP::true(); };
-    $conf{json_pp}{get_false} = sub { return JSON::PP::false(); };
+    $conf{json_pp_2} = { %{ $conf{json_2} } };
+    $conf{json_pp_2}{get_true}  = sub { return JSON::PP::true(); };
+    $conf{json_pp_2}{get_false} = sub { return JSON::PP::false(); };
+
+    # JSON::PP 3.99 enables allow_nonref by default.
+    $conf{json_pp_3} = { %{ $conf{json_pp_2} } };
+    $conf{json_pp_3}{create_object} = sub {
+        $conf{json_pp_2}{create_object}->($_[0], {allow_nonref => 0, %{$_[1]}});
+    };
+
+    $conf{json_pp_4} = { %{ $conf{json_pp_3} } };
 
     # Cpanel::JSON::XS is a fork of JSON::XS (currently)
     $conf{cpanel_json_xs} = { %{ $conf{json_xs_2} } };
@@ -224,12 +232,15 @@ BEGIN {
     # JSON::XS 4 is almost the same as JSON::XS 3. It only enables
     # allow_nonref by default.
     $conf{json_xs_4} = { %{ $conf{json_xs_3} } };
+    $conf{json_xs_4}{create_object} = sub {
+        $conf{json_xs_3}{create_object}->($_[0], {allow_nonref => 0, %{$_[1]}});
+    };
 }
 
 sub _make_key {
     my $handler = shift;
     ( my $key = lc($handler) ) =~ s/::/_/g;
-    if ( 'json_xs' eq $key || 'json' eq $key ) {
+    if ( 'json_xs' eq $key || 'json_pp' eq $key || 'json' eq $key ) {
         no strict 'refs';
         $key .= "_" . ( split /\./, ${"$handler\::VERSION"} )[0];
     }
diff --git a/t/15-allow_nonref.t b/t/15-allow_nonref.t
new file mode 100644
index 0000000..7a36df3
--- /dev/null
+++ b/t/15-allow_nonref.t
@@ -0,0 +1,48 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use JSON::Any;
+
+my @backends = qw(CPANEL XS PP JSON DWIW);
+
+plan tests => @backends * 2 * 3;
+
+test ($_) for @backends;
+
+sub test {
+    my ($backend) = @_;
+
+    SKIP: {
+        my $j = eval {
+            JSON::Any->import($backend);
+            JSON::Any->new;
+        };
+
+        note("$backend: " . $@), skip("Backend $backend failed to load", 2 * 3) if $@;
+
+        $j and $j->handler or next;
+
+        note "handler is " . ( ref( $j->handler ) || $j->handlerType );
+
+        for my $json ( 'null', '42', '"hello"' ) {
+            my $data;
+            isnt(
+                exception { $data = $j->jsonToObj($json) },
+                undef,
+                "decoding '$json' is not supported",
+            );
+        }
+
+        for my $object ( undef, 42, 'hello' ) {
+            my $json;
+            my $printable_object = $object // 'undef';
+            isnt(
+                exception { $json = $j->objToJson($object) },
+                undef,
+                "encoding '$printable_object' is not supported",
+            );
+        }
+    };
+}
-- 
2.17.2