subtest
'route-application'
=>
sub
{
my
$data
= {
listen
=> [3000, 3001], };
my
(
$r
,
$values
);
(
$r
,
$values
) = validator(
$data
)->_apply(
'/listen/*'
=>
sub
{
@_
== 2 });
ok
$r
,
"positive simple path appliaction"
;
(
$r
,
$values
) = validator(
$data
)->_apply(
'/listen/*'
=>
sub
{
@_
> 2 });
ok !
$r
,
"simple path appliaction passed with false condition"
;
(
$r
,
$values
) = validator(
$data
)->_apply(
'/ABC/*'
=>
sub
{
@_
== 0; });
ok !
$r
,
"void path appliaction with positve condition matches nothing"
;
(
$r
,
$values
) = validator(
$data
)->_apply(
'/ABC/*'
=>
sub
{
@_
> 0 });
ok !
$r
,
"void path appliaction with false condition"
;
};
subtest
'undef-value-in-hash'
=>
sub
{
my
(
$r
,
$values
) = validator({
x
=>
undef
})->_apply(
'/x'
=>
sub
{ 1 });
ok
$r
;
is @{
$values
->{routes} }, 1;
is
$values
->{routes}->[0],
"/x"
;
is @{
$values
->{
values
} }, 1;
is
$values
->{
values
}->[0],
undef
,
"undef is valid value"
;
};
subtest
'simple-error'
=>
sub
{
my
$data
= {
listen
=> [3000, 3001], };
my
$v
;
$v
= validator(
$data
)->(
on
=>
'/*'
,
should
=>
sub
{ 0; },
because
=>
'I want it fails'
,
);
ok
$v
,
"we always return self"
;
ok !
$v
->is_valid,
'failed by should rule'
;
is @{
$v
->errors }, 1,
"got exactly 1 error"
;
is
$v
->errors->[0]->reason,
'I want it fails'
,
'got error reason'
;
};
subtest
'selects-nothing-should-fail'
=>
sub
{
my
$errors
= validator({
a
=> 2 })->(
on
=>
'/b'
,
should
=>
sub
{ 1; },
because
=>
'b should present'
,
)->errors;
is
@$errors
, 1;
like
$errors
->[0],
qr/b should present/
;
};
sub
test_validator($$@) {
my
(
$right_data
,
$wrong_data
,
%rules
) =
@_
;
my
$v_right
= validator(
$right_data
);
my
$v_wrong
= validator(
$wrong_data
);
local
$Test::Builder::Level
=
$Test::Builder::Level
+ 1;
ok
$v_right
->validate(
%rules
)->is_valid,
"valid on valid rules"
;
ok !
$v_wrong
->validate(
%rules
)->is_valid,
"invalid on invalid rules"
;
}
test_validator(
{
listen
=> [3000, 3001], },
{
listen
=> [], },
on
=>
'/listen/*'
,
should
=>
sub
{
@_
> 0 },
because
=>
"'listen' should define one or more listening ports"
,
);
test_validator(
{
listen
=> [3000, 3001] },
{
listen
=> [3000, -1] },
on
=>
'/listen/*'
,
should
=>
sub
{
@_
> 0 },
because
=>
'...'
,
each
=>
sub
{
shift
->(
on
=>
"//listen/$_"
,
should
=>
sub
{
$_
[0] > 0},
because
=>
"port should be positive"
,
)
},
);
subtest
'simple-1-children-negative'
=>
sub
{
my
$data
= {
listen
=> [5, -11, -3001], };
my
$v
= validator(
$data
);
$v
->(
on
=>
'/listen/*'
,
should
=>
sub
{
@_
> 0 },
because
=>
'...'
,
each
=>
sub
{
$v
->(
on
=>
"/listen/$_"
,
should
=>
sub
{
$_
[0] > 0},
because
=>
"port should be positive"
,
)
},
);
ok !
$v
->is_valid,
"invalid on invalid and simple 'each' test"
;
is @{
$v
->errors }, 1,
"got exactly 1 error"
;
is
$v
->errors->[0]->reason,
'port should be positive'
,
'got error reason'
;
};
subtest
'simple-1-children-positive'
=>
sub
{
my
$data
= {
listen
=> [3001, 3002], };
my
$v
= validator(
$data
);
$v
->(
on
=>
'/listen/*'
,
should
=>
sub
{
@_
> 0 },
because
=>
'...'
,
each
=>
sub
{
$v
->(
on
=>
"//listen/$_"
,
should
=>
sub
{
$_
[0] > 0},
because
=>
"port should be positive"
,
)
},
);
ok
$v
->is_valid,
"valid on valid and simple 'each' test"
;
};
subtest
'simple-custom-error'
=>
sub
{
my
$data
= [
"a"
];
my
$errors
= validator(
$data
)->(
on
=>
'/var:0'
,
should
=>
sub
{ 1 },
because
=>
'...'
,
each
=>
sub
{
my
$var
;
my
$value
=
$var
->();
shift
->report_error(
"custom fail on value '$value'"
);
}
)->errors;
is
@$errors
, 1,
"got exactly 1 error"
;
is
$errors
->[0]->reason,
"custom fail on value 'a'"
;
};
done_testing;