Cpanel-JSON-XS
view release on metacpan or search on metacpan
- Silence Gconvert -Wunused-result.
gcvt returns a string, sprintf int, so suppress the retval
4.06 2018-08-22 (rurban)
- Fix overloaded eq/ne comparisons (GH #116 by demerphq, GH #117 by Graham Knopp):
detect strings, protect from endless recursion. false is now ne "True".
clarify eq/ne rules in the docs.
4.05 2018-08-19 (rurban)
- Set decoded type (PR #115 by Pali)
- Add json_type_weaken (PR #114 by Pali)
- Fix tests for 5.6 (rurban, pali)
4.04 2018-06-22 (rurban)
- Fix bignum NaN/inf handling (#78 reported by Slaven Rezic)
- Move author tests to xt/ as suggested in #106, added a make xtest target.
Fixes a test fail with ASAN.
4.03 2018-06-21 (rurban)
- Add sereal cpanel_json_xs type (#110 James Rouzier)
- Fix bencode/bdecode methods in cpanel_json_xs (#111 Fulvio Scapin)
Like L<C<json_type_anyof>|/json_type_anyof>, but scalar can be only
perl's C<undef>.
=back
=head2 Recursive specifications
=over 4
=item json_type_weaken
This function can be used as an argument for L</json_type_arrayof>,
L</json_type_hashof> or L</json_type_anyof> functions to create weak
references suitable for complicated recursive structures. It depends
on L<the weaken function from Scalar::Util|Scalar::Util/weaken> module.
See following example:
my $struct = {
type => JSON_TYPE_STRING,
array => json_type_arrayof(JSON_TYPE_INT),
};
$struct->{recursive} = json_type_anyof(
json_type_weaken($struct),
json_type_arrayof(JSON_TYPE_STRING),
);
If you want to encode all perl scalars to JSON string types despite
how complicated is input perl structure you can define JSON type
specification for alternatives recursively. It could be defined as:
my $type = json_type_anyof();
$type->[0] = JSON_TYPE_STRING_OR_NULL;
$type->[1] = json_type_arrayof(json_type_weaken($type));
$type->[2] = json_type_hashof(json_type_weaken($type));
print encode_json([ 10, "10", { key => 10 } ], $type);
# ["10","10",{"key":"10"}]
An alternative solution for encoding all scalars to JSON strings is to
use C<type_all_string> method of L<Cpanel::JSON::XS> itself:
my $json = Cpanel::JSON::XS->new->type_all_string;
print $json->encode([ 10, "10", { key => 10 } ]);
# ["10","10",{"key":"10"}]
This module is available under the same licences as perl, the Artistic
license and the GPL.
=cut
use strict;
use warnings;
BEGIN {
if (eval { require Scalar::Util }) {
Scalar::Util->import('weaken');
} else {
*weaken = sub($) { die 'Scalar::Util is required for weaken' };
}
}
# This exports needed XS constants to perl
use Cpanel::JSON::XS ();
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = our @EXPORT_OK = qw(
json_type_arrayof
json_type_hashof
json_type_anyof
json_type_null_or_anyof
json_type_weaken
JSON_TYPE_NULL
JSON_TYPE_BOOL
JSON_TYPE_INT
JSON_TYPE_FLOAT
JSON_TYPE_STRING
JSON_TYPE_BOOL_OR_NULL
JSON_TYPE_INT_OR_NULL
JSON_TYPE_FLOAT_OR_NULL
JSON_TYPE_STRING_OR_NULL
JSON_TYPE_ARRAYOF_CLASS
JSON_TYPE_HASHOF_CLASS
JSON_TYPE_ANYOF_CLASS
);
use constant JSON_TYPE_WEAKEN_CLASS => 'Cpanel::JSON::XS::Type::Weaken';
sub json_type_anyof {
my ($scalar, $array, $hash);
my ($scalar_weaken, $array_weaken, $hash_weaken);
foreach (@_) {
my $type = $_;
my $ref = ref($_);
my $weaken;
if ($ref eq JSON_TYPE_WEAKEN_CLASS) {
$type = ${$type};
$ref = ref($type);
$weaken = 1;
}
if ($ref eq '') {
die 'Only one scalar type can be specified in anyof' if defined $scalar;
$scalar = $type;
$scalar_weaken = $weaken;
} elsif ($ref eq 'ARRAY' or $ref eq JSON_TYPE_ARRAYOF_CLASS) {
die 'Only one array type can be specified in anyof' if defined $array;
$array = $type;
$array_weaken = $weaken;
} elsif ($ref eq 'HASH' or $ref eq JSON_TYPE_HASHOF_CLASS) {
die 'Only one hash type can be specified in anyof' if defined $hash;
$hash = $type;
$hash_weaken = $weaken;
} else {
die 'Only scalar, array or hash can be specified in anyof';
}
}
my $type = [$scalar, $array, $hash];
weaken $type->[0] if $scalar_weaken;
weaken $type->[1] if $array_weaken;
weaken $type->[2] if $hash_weaken;
return bless $type, JSON_TYPE_ANYOF_CLASS;
}
sub json_type_null_or_anyof {
foreach (@_) {
die 'Scalar cannot be specified in null_or_anyof' if ref($_) eq '';
}
return json_type_anyof(JSON_TYPE_CAN_BE_NULL, @_);
}
sub json_type_arrayof {
die 'Exactly one type must be specified in arrayof' if scalar @_ != 1;
my $type = $_[0];
if (ref($type) eq JSON_TYPE_WEAKEN_CLASS) {
$type = ${$type};
weaken $type;
}
return bless \$type, JSON_TYPE_ARRAYOF_CLASS;
}
sub json_type_hashof {
die 'Exactly one type must be specified in hashof' if scalar @_ != 1;
my $type = $_[0];
if (ref($type) eq JSON_TYPE_WEAKEN_CLASS) {
$type = ${$type};
weaken $type;
}
return bless \$type, JSON_TYPE_HASHOF_CLASS;
}
sub json_type_weaken {
die 'Exactly one type must be specified in weaken' if scalar @_ != 1;
die 'Scalar cannot be specfied in weaken' if ref($_[0]) eq '';
return bless \(my $type = $_[0]), JSON_TYPE_WEAKEN_CLASS;
}
1;
sv_pvutf8n||5.006000|
sv_pvutf8||5.006000|
sv_pv||5.006000|
sv_recode_to_utf8||5.007003|
sv_reftype|||
sv_ref|||
sv_replace|||
sv_report_used|||
sv_resetpvn|||
sv_reset|||
sv_rvweaken||5.006000|
sv_sethek|||
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p
sv_setpvf_mg_nocontext|||pvn
sv_setpvf_mg|5.006000|5.004000|pv
sv_setpvf_nocontext|||vn
sv_setpvf||5.004000|v
t/118_type.t view on Meta::CPAN
use strict;
use warnings;
use Config;
use Cpanel::JSON::XS;
use Cpanel::JSON::XS::Type;
my $have_weaken;
BEGIN {
if (eval { require Scalar::Util }) {
Scalar::Util->import('weaken');
$have_weaken = 1;
}
$have_weaken = 0 if $] < 5.008;
}
use Test::More tests => 381;
my $cjson = Cpanel::JSON::XS->new->canonical->allow_nonref->require_types;
my $bigcjson = Cpanel::JSON::XS->new->canonical->allow_nonref->require_types->allow_bignum;
foreach my $false (Cpanel::JSON::XS::false, undef, 0, 0.0, 0E0, !!0, !1, "0", "", \0) {
is($cjson->encode($false, JSON_TYPE_BOOL), 'false');
}
t/118_type.t view on Meta::CPAN
my $perl_struct = { key1 => [ "10", 10, 10.5, Cpanel::JSON::XS::true ],
key2 => { key => "string" }, key3 => Cpanel::JSON::XS::false };
my $type_spec = json_type_hashof(json_type_anyof(json_type_arrayof(JSON_TYPE_INT),
json_type_hashof(JSON_TYPE_STRING), JSON_TYPE_BOOL));
my $json_string = $cjson->encode($perl_struct, $type_spec);
is($json_string, '{"key1":[10,10,10,1],"key2":{"key":"string"},"key3":false}');
}
SKIP: {
skip "no Scalar::Util in $]", 2 unless $have_weaken;
my $weakref;
{
my $perl_struct = { key1 => 'string', key2 => '10',
key3 => { key1 => 'level1', key2 => '20',
key3 => { key1 => 'level2', key2 => 30 } } };
my $type_spec = { key1 => JSON_TYPE_STRING, key2 => JSON_TYPE_INT };
$type_spec->{key3} = $type_spec;
weaken($type_spec->{key3});
my $json_string = $cjson->encode($perl_struct, $type_spec);
is($json_string, '{"key1":"string","key2":10,"key3":'
.'{"key1":"level1","key2":20,"key3":{"key1":"level2","key2":30}}}');
$weakref = $type_spec;
weaken($weakref);
}
ok(not defined $weakref);
}
SKIP: {
skip "no Scalar::Util in $]", 2 unless $have_weaken;
my $weakref;
{
my $perl_struct = [ "10", 10.2, undef, 10, [ [ "10", 10 ], 10.3, undef ], 10 ];
my $type_arrayof = json_type_arrayof(my $type_spec);
$type_spec = json_type_anyof(JSON_TYPE_INT_OR_NULL, $type_arrayof);
${$type_arrayof} = $type_spec;
weaken(${$type_arrayof});
my $json_string = $cjson->encode($perl_struct, $type_spec);
is($json_string, '[10,10,null,10,[[10,10],10,null],10]');
$weakref = $type_spec;
weaken($weakref);
}
ok(not defined $weakref);
}
SKIP: {
skip "no Scalar::Util in $]", 2 unless $have_weaken;
my $weakref;
{
my $perl_struct = { type => "TYPE", value => "VALUE",
position => { line => 10, column => 11 },
content => [
{ type => "TYPE2", value => "VALUE2",
position => { line => 12, column => 13 } } ] };
my $type_spec = { type => JSON_TYPE_STRING, value => 0,
position => { line => JSON_TYPE_INT, column => JSON_TYPE_INT } };
my $type_spec_content = json_type_arrayof($type_spec);
weaken(${$type_spec_content});
$type_spec->{content} = $type_spec_content;
my $json_string = $cjson->encode($perl_struct, $type_spec);
is ($json_string,
'{"content":[{"position":{"column":13,"line":12},"type":"TYPE2","value":"VALUE2"}],'.
'"position":{"column":11,"line":10},"type":"TYPE","value":"VALUE"}');
$weakref = $type_spec;
weaken($weakref);
}
ok(not defined $weakref);
}
ok(!defined eval { json_type_anyof(JSON_TYPE_STRING, JSON_TYPE_INT) });
like($@, qr/Only one scalar type can be specified in anyof/);
ok(!defined eval { json_type_anyof([ JSON_TYPE_STRING ], [ JSON_TYPE_INT ]) });
like($@, qr/Only one array type can be specified in anyof/);
t/118_type.t view on Meta::CPAN
}
foreach my $val (['0', JSON_TYPE_INT], ['0.0', JSON_TYPE_FLOAT]) {
my $warn;
local $SIG{__WARN__} = sub { $warn = $_[0] };
is($cjson->encode(my $str = 'string_value', $val->[1]), $val->[0]); my $line = __LINE__;
like($warn, qr/Argument "string_value" isn't numeric in (?:XS )?subroutine entry at \Q$0\E line \Q$line\E/);
}
SKIP: {
skip "no Scalar::Util in $]", 1 unless $have_weaken;
my $struct = {};
$struct->{recursive} = json_type_arrayof(json_type_weaken($struct));
my $weakref = $struct->{recursive};
weaken($weakref);
undef $struct;
ok(!defined $weakref);
}
SKIP: {
skip "no Scalar::Util in $]", 1 unless $have_weaken;
my $struct = {};
$struct->{recursive} = json_type_hashof(json_type_weaken($struct));
my $weakref = $struct->{recursive};
weaken($weakref);
undef $struct;
ok(!defined $weakref);
}
SKIP: {
skip "no Scalar::Util in $]", 1 unless $have_weaken;
my $struct = {};
$struct->{recursive} = json_type_anyof(json_type_weaken($struct));
my $weakref = $struct->{recursive};
weaken($weakref);
undef $struct;
ok(!defined $weakref);
}
ok(!defined eval { $cjson->encode(1) });
like($@, qr/type for '1' was not specified/);
ok(!defined eval { $cjson->encode(1, undef) });
like($@, qr/type for '1' was not specified/);
( run in 0.716 second using v1.01-cache-2.11-cpan-65fba6d93b7 )