summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2018-06-17 16:11:50 +0200
committerYorhel <git@yorhel.nl>2018-06-17 16:11:52 +0200
commitcbd2e59cca389bf683d0b2d8664b85a532d9e3fe (patch)
tree7393c2f9abb24f50074a2a121e01dd73ce5cb2f0
parentc7c265d397869be6187f60317d98be745e5f3279 (diff)
Validate::Interop::coerce_for_json(): Add "unknown" config option + inherit that from schema
This allows doing some basic normalization (i.e. removing keys) from the generated JSON.
-rw-r--r--lib/TUWF/Validate/Interop.pm17
-rw-r--r--t/interop.t9
2 files changed, 20 insertions, 6 deletions
diff --git a/lib/TUWF/Validate/Interop.pm b/lib/TUWF/Validate/Interop.pm
index deee9da..fcf6f0a 100644
--- a/lib/TUWF/Validate/Interop.pm
+++ b/lib/TUWF/Validate/Interop.pm
@@ -4,13 +4,14 @@ use strict;
use warnings;
use TUWF::Validate;
use Exporter 'import';
+use Carp 'croak';
our @EXPORT_OK = ('analyze');
# Analyzed ("flattened") object:
# { type => scalar | bool | num | int | array | hash | any
# , min, max, minlength, maxlength, required, regexes
-# , keys, values
+# , keys, values, unknown
# }
sub _merge_type {
@@ -48,6 +49,7 @@ sub _merge {
sub _merge_toplevel {
my($c, $o) = @_;
$o->{required} ||= $c->{schema}{required};
+ $o->{unknown} ||= $c->{schema}{unknown};
$o->{type} = $c->{schema}{type} if !$o->{type} || $o->{type} eq 'any';
_merge $c, $o;
@@ -64,15 +66,22 @@ sub analyze {
# Assumes that $obj already has the required format/structure, odd things may
# happen if this is not the case.
+# unknown => remove|reject|pass
sub coerce_for_json {
- my($o, $obj) = @_;
+ my($o, $obj, %opt) = @_;
+ $opt{unknown} ||= $o->{unknown};
return undef if !defined $obj;
return $obj+0 if $o->{type} eq 'num';
return int $obj if $o->{type} eq 'int';
return $obj ? \1 : \0 if $o->{type} eq 'bool';
return "$obj" if $o->{type} eq 'scalar';
- return [map $o->{values}->coerce_for_json($_), @$obj] if $o->{type} eq 'array' && $o->{values};
- return {map +($_, $o->{keys}{$_} ? $o->{keys}{$_}->coerce_for_json($obj->{$_}) : $obj->{$_}), keys %$obj} if $o->{type} eq 'hash' && $o->{keys};
+ return [map $o->{values}->coerce_for_json($_, %opt), @$obj] if $o->{type} eq 'array' && $o->{values};
+ return {map {
+ $o->{keys}{$_} ? ($_, $o->{keys}{$_}->coerce_for_json($obj->{$_}, %opt)) :
+ $opt{unknown} eq 'pass' ? ($_, $obj->{$_}) :
+ $opt{unknown} eq 'remove' ? ()
+ : croak "Unknown key '$_' in hash in coerce_for_json()"
+ } keys %$obj} if $o->{type} eq 'hash' && $o->{keys};
$obj
}
diff --git a/t/interop.t b/t/interop.t
index 878de1b..acb3fb0 100644
--- a/t/interop.t
+++ b/t/interop.t
@@ -52,6 +52,7 @@ my @serialized = (
[ { type => 'array', values => {anybool=>1} }, ['a',1,0], '[true,true,false]' ],
[ { type => 'hash' }, {}, '{}' ],
[ { type => 'hash' }, {a=>1,b=>'2'}, '{"a":1,"b":"2"}' ],
+ [ { type => 'hash', keys => {b=>{}} }, {}, '{}' ],
[ { type => 'hash', keys => {a=>{anybool=>1},b=>{int=>1}} }, {a=>1,b=>'10'}, '{"a":true,"b":10}' ],
[ { required => 0 }, undef, 'null' ],
[ { required => 0, jsonbool => 1 }, undef, 'null' ],
@@ -65,14 +66,18 @@ subtest 'JSON::XS coercion', sub {
eval { require JSON::XS; 1 } or plan skip_all => 'JSON::XS not installed';
my @extra = (
[ { type => 'num' }, '10', '10' ],
- [ { type => 'hash', keys => {a=>{anybool=>1},b=>{int=>1}} }, {a=>1,b=>'10',c=>[]}, '{"a":true,"b":10,"c":[]}' ],
+ [ { type => 'hash', keys => {a=>{anybool=>1},b=>{int=>1}} }, {a=>1,b=>'10',c=>[]}, '{"a":true,"b":10}' ],
+ [ { type => 'hash', unknown => 'pass', keys => {a=>{anybool=>1},b=>{int=>1}} }, {a=>1,b=>'10',c=>[]}, '{"a":true,"b":10,"c":[]}' ],
);
+ my $js = JSON::XS->new->canonical->allow_nonref;
for (@serialized, @extra) {
my($schema, $in, $out) = @$_;
my $inc = dclone([$in])->[0];
- is(JSON::XS->new->canonical->allow_nonref->encode(compile({}, $schema)->analyze->coerce_for_json($in)), $out);
+ is($js->encode(compile({}, $schema)->analyze->coerce_for_json($in)), $out);
is_deeply $inc, $in;
}
+ is($js->encode(compile({}, { type => 'hash', keys => {} })->analyze->coerce_for_json({a=>1}, unknown => 'pass')), '{"a":1}');
+ ok !eval { $js->encode(compile({}, { type => 'hash', keys => {} })->analyze->coerce_for_json({a=>1}, unknown => 'reject')); 1 };
};
subtest 'Cpanel::JSON::XS coercion', sub {