Cpanel-JSON-XS 4.09

Silence Gconvert -Wunused-result.

Add unblessed_bool property (PR #118 by Pali)

Add seperate allow_dupkeys property, in relaxed (#122),
Fixed allow_dupkeys for the XS slow path,
Silence 2 -Wunused-value warnings,
Fix ->unblessed_bool to produce modifiable perl structures (PR #121 by Pali).

META.json

@@ -143,5 +143,5 @@
       }
    },
    "version" : "5.028002c",
-   "x_serialization_backend" : "Cpanel::JSON::XS version 4.06"
+   "x_serialization_backend" : "Cpanel::JSON::XS version 4.09"
 }

Porting/Maintainers.pl

@@ -432,7 +432,7 @@ package Maintainers;
     },
 
     'Cpanel::JSON::XS' => {
-        'DISTRIBUTION' => 'RURBAN/Cpanel-JSON-XS-4.06.tar.gz',
+        'DISTRIBUTION' => 'RURBAN/Cpanel-JSON-XS-4.09.tar.gz',
         'FILES'        => q[cpan/Cpanel-JSON-XS],
         'EXCLUDED'     => [
             '.appveyor.yml',

cpan/Cpanel-JSON-XS/XS.pm

@@ -1,5 +1,5 @@
 package Cpanel::JSON::XS;
-our $VERSION = '4.06';
+our $VERSION = '4.09';
 our $XS_VERSION = $VERSION;
 # $VERSION = eval $VERSION;
 
@@ -645,11 +645,12 @@ L</allow_barekey> option.
 
     { foo:"bar" }
 
-=item * duplicate keys
+=item * allow_dupkeys
 
-With relaxed decoding of duplicate keys does not error and are silently accepted.
+Allow decoding of duplicate keys in hashes. By default duplicate keys are forbidden.
 See L<http://seriot.ch/parsing_json.php#24>:
 RFC 7159 section 4: "The names within an object should be unique."
+See the L</allow_dupkeys> option.
 
 =back
 
@@ -701,6 +702,18 @@ C<"\/">.
 This setting has no effect when decoding JSON texts.
 
 
+=item $json = $json->unblessed_bool ([$enable])
+
+=item $enabled = $json->get_unblessed_bool
+
+    $json = $json->unblessed_bool([$enable])
+
+If C<$enable> is true (or missing), then C<decode> will return
+Perl non-object boolean variables (1 and 0) for JSON booleans
+(C<true> and C<false>). If C<$enable> is false, then C<decode>
+will return C<Cpanel::JSON::XS::Boolean> objects for JSON booleans.
+
+
 =item $json = $json->allow_singlequote ([$enable])
 
 =item $enabled = $json->get_allow_singlequote
@@ -812,6 +825,22 @@ This option does not affect C<decode> in any way.
 This option is special to this module, it is not supported by other
 encoders.  So it is not recommended to use it.
 
+=item $json = $json->allow_dupkeys ([$enable])
+
+=item $enabled = $json->get_allow_dupkeys
+
+If C<$enable> is true (or missing), then the C<decode> method will not
+die when it encounters duplicate keys in a hash.
+C<allow_dupkeys> is also enabled in the C<relaxed> mode.
+
+The JSON spec allows duplicate name in objects but recommends to
+disable it, however with Perl hashes they are impossible, parsing
+JSON in Perl silently ignores duplicate names, using the last value
+found.
+
+See L<http://seriot.ch/parsing_json.php#24>:
+RFC 7159 section 4: "The names within an object should be unique."
+
 =item $json = $json->allow_blessed ([$enable])
 
 =item $enabled = $json->get_allow_blessed

cpan/Cpanel-JSON-XS/XS.xs

@@ -24,6 +24,14 @@
 # define snprintf _snprintf // C compilers have this in stdio.h
 #endif
 
+#ifndef PERL_UNUSED_RESULT
+#  if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
+#    define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
+#  else
+#    define PERL_UNUSED_RESULT(v) ((void)(v))
+#  endif
+#endif
+
 #if defined(_AIX) && (!defined(HAS_LONG_DOUBLE) || AIX_WORKAROUND)
 #define HAVE_NO_POWL
 #endif
@@ -268,10 +276,12 @@ mingw_modfl(long double x, long double *ip)
 #define F_ESCAPE_SLASH    0x00080000UL
 #define F_SORT_BY         0x00100000UL
 #define F_ALLOW_STRINGIFY 0x00200000UL
+#define F_UNBLESSED_BOOL  0x00400000UL
+#define F_ALLOW_DUPKEYS   0x00800000UL
 #define F_HOOK            0x80000000UL /* some hooks exist, so slow-path processing */
 
 #define F_PRETTY    F_INDENT | F_SPACE_BEFORE | F_SPACE_AFTER
-#define SET_RELAXED (F_RELAXED | F_ALLOW_BAREKEY | F_ALLOW_SQUOTE)
+#define SET_RELAXED (F_RELAXED | F_ALLOW_BAREKEY | F_ALLOW_SQUOTE | F_ALLOW_DUPKEYS)
 
 #define INIT_SIZE   32 /* initial scalar size to be allocated */
 #define INDENT_STEP 3  /* default spaces per indentation level */
@@ -1810,11 +1820,13 @@ encode_sv (pTHX_ enc_t *enc, SV *sv, SV *typesv)
 # endif
       }
 #endif
+
 #ifdef USE_QUADMATH
       quadmath_snprintf(enc->cur, enc->end - enc->cur, "%.*Qg", (int)NV_DIG, nv);
 #else
-      (void)Gconvert (nv, NV_DIG, 0, enc->cur);
+      PERL_UNUSED_RESULT(Gconvert (nv, NV_DIG, 0, enc->cur));
 #endif
+
 #ifdef NEED_NUMERIC_LOCALE_C
       if (loc_changed) {
 # ifdef HAS_USELOCALE
@@ -3243,7 +3255,7 @@ decode_hv (pTHX_ dec_t *dec, SV *typesv)
   SV *typerv;
   int allow_squote = dec->json.flags & F_ALLOW_SQUOTE;
   int allow_barekey = dec->json.flags & F_ALLOW_BAREKEY;
-  int relaxed = dec->json.flags & F_RELAXED;
+  int allow_dupkeys = dec->json.flags & F_ALLOW_DUPKEYS;
   char endstr = '"';
 
   DEC_INC_DEPTH;
@@ -3303,14 +3315,16 @@ decode_hv (pTHX_ dec_t *dec, SV *typesv)
                   if (!key)
                     goto fail;
 
+                  if (!allow_dupkeys && UNLIKELY(hv_exists_ent (hv, key, 0))) {
+                    ERR ("Duplicate keys not allowed");
+                  }
                   decode_ws (dec); EXPECT_CH (':');
-
                   decode_ws (dec);
 
                   if (typesv)
                     {
                       value_typesv = newSV (0);
-                      hv_store_ent (typehv, key, value_typesv, 0);
+                      (void)hv_store_ent (typehv, key, value_typesv, 0);
                     }
 
                   value = decode_sv (aTHX_ dec, value_typesv);
@@ -3320,7 +3334,7 @@ decode_hv (pTHX_ dec_t *dec, SV *typesv)
                       goto fail;
                     }
 
-                  hv_store_ent (hv, key, value, 0);
+                  (void)hv_store_ent (hv, key, value, 0);
                   SvREFCNT_dec (key);
 
                   break;
@@ -3340,14 +3354,12 @@ decode_hv (pTHX_ dec_t *dec, SV *typesv)
                   if (UNLIKELY(p - key > I32_MAX))
                     ERR ("Hash key too large");
 #endif
-                  if (!relaxed && UNLIKELY(hv_exists (hv, key, len))) {
+                  if (!allow_dupkeys && UNLIKELY(hv_exists (hv, key, len))) {
                     ERR ("Duplicate keys not allowed");
                   }
 
                   dec->cur = p + 1;
-
                   decode_ws (dec); if (*p != ':') EXPECT_CH (':');
-
                   decode_ws (dec);
 
                   if (typesv)
@@ -3590,6 +3602,8 @@ decode_sv (pTHX_ dec_t *dec, SV *typesv)
             dec->cur += 4;
             if (typesv)
               sv_setiv_mg (typesv, JSON_TYPE_BOOL);
+            if (dec->json.flags & F_UNBLESSED_BOOL)
+              return newSVsv (&PL_sv_yes);
             return newSVsv(MY_CXT.json_true);
           }
         else
@@ -3604,6 +3618,8 @@ decode_sv (pTHX_ dec_t *dec, SV *typesv)
             dec->cur += 5;
             if (typesv)
               sv_setiv_mg (typesv, JSON_TYPE_BOOL);
+            if (dec->json.flags & F_UNBLESSED_BOOL)
+              return newSVsv (&PL_sv_no);
             return newSVsv(MY_CXT.json_false);
           }
         else
@@ -4093,6 +4109,8 @@ void ascii (JSON *self, int enable = 1)
         allow_bignum    = F_ALLOW_BIGNUM
         escape_slash    = F_ESCAPE_SLASH
         allow_stringify = F_ALLOW_STRINGIFY
+        unblessed_bool  = F_UNBLESSED_BOOL
+        allow_dupkeys   = F_ALLOW_DUPKEYS
     PPCODE:
         if (enable)
           self->flags |=  ix;
@@ -4121,7 +4139,9 @@ void get_ascii (JSON *self)
         get_allow_singlequote = F_ALLOW_SQUOTE
         get_allow_bignum    = F_ALLOW_BIGNUM
         get_escape_slash    = F_ESCAPE_SLASH
-        get_allow_stringify  = F_ALLOW_STRINGIFY
+        get_allow_stringify = F_ALLOW_STRINGIFY
+        get_unblessed_bool  = F_UNBLESSED_BOOL
+        get_allow_dupkeys   = F_ALLOW_DUPKEYS
     PPCODE:
         XPUSHs (boolSV (self->flags & ix));
 

cpan/Cpanel-JSON-XS/t/25_boolean.t

@@ -1,8 +1,16 @@
 use strict;
-use Test::More tests => 32;
+use Test::More tests => 42;
 use Cpanel::JSON::XS ();
 use Config;
 
+my $have_blessed;
+BEGIN {
+  if (eval { require Scalar::Util }) {
+    Scalar::Util->import('blessed');
+    $have_blessed = 1;
+  }
+}
+
 my $booltrue  = q({"is_true":true});
 my $boolfalse = q({"is_false":false});
 my $truefalse = "[true,false]";
@@ -11,6 +19,7 @@ my $true  = Cpanel::JSON::XS::true;
 my $false = Cpanel::JSON::XS::false;
 
 my $nonref_cjson = Cpanel::JSON::XS->new->allow_nonref;
+my $unblessed_bool_cjson = Cpanel::JSON::XS->new->unblessed_bool;
 
 # from JSON::MaybeXS
 my $data = $cjson->decode('{"foo": true, "bar": false, "baz": 1}');
@@ -86,3 +95,27 @@ ok( Cpanel::JSON::XS::is_bool($js->[1]), "false is_bool");
 
 # GH #53
 ok( !Cpanel::JSON::XS::is_bool( [] ), "[] !is_bool");
+
+
+$js = $unblessed_bool_cjson->decode($booltrue);
+SKIP: {
+  skip "no Scalar::Util in $]", 1 unless $have_blessed;
+  ok(!blessed($js->{is_true}), "->unblessed_bool for JSON true does not return blessed object");
+}
+cmp_ok($js->{is_true}, "==", 1, "->unblessed_bool for JSON true returns correct Perl bool value");
+cmp_ok($js->{is_true}, "eq", "1", "->unblessed_bool for JSON true returns correct Perl bool value");
+
+$js = $unblessed_bool_cjson->decode($boolfalse);
+SKIP: {
+  skip "no Scalar::Util in $]", 1 unless $have_blessed;
+  ok(!blessed($js->{is_false}), "->unblessed_bool for JSON false does not return blessed object");
+}
+cmp_ok($js->{is_false}, "==", 0, "->unblessed_bool for JSON false returns correct Perl bool value");
+cmp_ok($js->{is_false}, "eq", "", "->unblessed_bool for JSON false returns correct Perl bool value");
+
+is($unblessed_bool_cjson->encode(do { my $struct = $unblessed_bool_cjson->decode($truefalse, my $types); ($struct, $types) }), $truefalse, "encode(decode(boolean)) is identity with ->unblessed_bool");
+is($cjson->encode(do { my $struct = $unblessed_bool_cjson->decode($truefalse, my $types); ($struct, $types) }), $truefalse, "booleans decoded by ->unblessed_bool(1) are encoded by ->unblessed_bool(0) in the same way");
+
+$js = $unblessed_bool_cjson->decode($truefalse);
+ok eval { $js->[0] = "new value 0" }, "decoded 'true' is modifiable" or diag($@);
+ok eval { $js->[1] = "new value 1" }, "decoded 'false' is modifiable" or diag($@);

cpan/Cpanel-JSON-XS/t/26_duplicate.t

@@ -1,13 +1,38 @@
-use Test::More tests => 4;
+use strict;
+use Test::More tests => 9;
 use Cpanel::JSON::XS;
 
 my $json = Cpanel::JSON::XS->new;
 
-# disallow dupkeys:
+# disallow dupkeys
 ok (!eval { $json->decode ('{"a":"b","a":"c"}') }); # y_object_duplicated_key.json
 ok (!eval { $json->decode ('{"a":"b","a":"b"}') }); # y_object_duplicated_key_and_value.json
 
+# relaxed allows dupkeys
 $json->relaxed;
-is (encode_json ($json->decode ('{"a":"b","a":"c"}')), '{"a":"c"}'); # y_object_duplicated_key.json
-is (encode_json ($json->decode ('{"a":"b","a":"b"}')), '{"a":"b"}'); # y_object_duplicated_key_and_value.json
+# y_object_duplicated_key.json
+is (encode_json ($json->decode ('{"a":"b","a":"c"}')), '{"a":"c"}', 'relaxed');
+# y_object_duplicated_key_and_value.json
+is (encode_json ($json->decode ('{"a":"b","a":"b"}')), '{"a":"b"}', 'relaxed');
 
+# turning off relaxed disallows dupkeys
+$json->relaxed(0);
+$json->allow_dupkeys; # but turn it on
+is (encode_json ($json->decode ('{"a":"b","a":"c"}')), '{"a":"c"}', 'allow_dupkeys');
+is (encode_json ($json->decode ('{"a":"b","a":"b"}')), '{"a":"b"}', 'allow_dupkeys');
+
+# disallow dupkeys explicitly
+$json->allow_dupkeys(0);
+eval { $json->decode ('{"a":"b","a":"c"}') };
+like ($@, qr/^Duplicate keys not allowed/, 'allow_dupkeys(0)');
+
+# disallow dupkeys explicitly with relaxed
+$json->relaxed;
+$json->allow_dupkeys(0);
+eval { $json->decode ('{"a":"b","a":"c"}') }; # the XS slow path
+like ($@, qr/^Duplicate keys not allowed/, 'relaxed and allow_dupkeys(0)');
+
+$json->allow_dupkeys;
+$json->relaxed(0); # tuning off relaxed needs to turn off dupkeys
+eval { $json->decode ('{"a":"b","a":"c"}') };
+like ($@, qr/^Duplicate keys not allowed/, 'relaxed(0)');

dist/Module-CoreList/lib/Module/CoreList.pm

@@ -363,6 +363,7 @@ our %released :const = (
     5.026003 => '2018-11-29',
     5.028001 => '2018-11-29',
     '5.028002c' => '2018-12-??',
+    '5.029001c' => '????',
  );
 
 sub version_sort {
@@ -17945,6 +17946,22 @@ our %delta :const = (
         removed => {
         }
     },
+    '5.029001c' => {
+        delta_from => '5.029000c',
+        changed => {
+            'B::Op_private'         => '5.029001',
+            'Module::CoreList'      => '5.20181019c',
+            'Module::CoreList::Utils'=> '5.20181019c',
+            'B::C'                  => '1.55_10',
+            'Cpanel::JSON::XS'      => '4.09',
+            'ExtUtils::Embed'       => '1.36',
+            'ExtUtils::MakeMaker'   => '8.35_07',
+            'ExtUtils::MM_Unix'     => '8.35_07',
+            'Win32'                 => '0.52_02',
+        },
+        removed => {
+        }
+    },
     5.029000 => {
         delta_from => 5.028,
         changed => {

pod/perlcdelta.pod

@@ -49,7 +49,16 @@ L<[perl #133423]|https://rt.perl.org/Ticket/Display.html?id=133423>
 
 =over 4
 
-=item *
+=item L<Cpanel::JSON::XS> 4.09
+
+Silence Gconvert -Wunused-result.
+
+Add unblessed_bool property (PR #118 by Pali)
+
+Add seperate allow_dupkeys property, in relaxed (#122),
+Fixed allow_dupkeys for the XS slow path,
+Silence 2 -Wunused-value warnings,
+Fix ->unblessed_bool to produce modifiable perl structures (PR #121 by Pali).
 
 =back