our
@ISA
=
qw(Exporter)
;
our
@EXPORT
=
qw(get_test_data normalize_test_result)
;
our
@EXPORT_OK
=
qw(get_test_data normalize_test_result)
;
our
%EXPORT_TAGS
= ();
my
@DELETE_KEYS
=
qw( datetime_obj )
;
my
%TESTS
;
sub
_load_tests {
my
(
$path
) =
@_
;
return
if
%TESTS
;
my
$has_json
=
eval
{ load
'JSON::MaybeXS'
; 1; };
my
$bin
= path(
$path
||
"$FindBin::Bin"
);
my
$parent
=
$bin
->parent();
my
$dir
=
$parent
->child(
t
=>
'data'
);
my
%checks
= (
string
=>
sub
{
length
},
expected
=>
sub
{
ref
$_
eq
'HASH'
},
);
$dir
->visit(
sub
{
my
(
$p
) =
@_
;
return
unless
$p
->is_file and
$p
->stringify =~ /\.yaml/;
eval
{
my
$test
= YAML::XS::LoadFile(
$p
->stringify );
my
$name
=
$p
->relative(
$parent
);
if
(
$test
->{options} and
$test
->{options}{AutoDetectJSON} ) {
die
"SKIPPED: No JSON::MaybeXS"
unless
$has_json
;
}
foreach
my
$check
(
sort
keys
%checks
) {
die
"Missing required key: $check"
unless
$test
->{
$check
};
local
$_
=
$test
->{
$check
};
die
"Validating $check failed!"
unless
$checks
{
$check
}->();
}
$test
->{expected} = normalize_test_result(
$test
->{expected});
$TESTS
{
$name
} =
$test
;
1;
} or
do
{
my
$err
= $@;
warn
(
sprintf
"loading YAML in %s failed: %s"
,
$p
->stringify,
$err
,
);
};
});
}
sub
get_test_data {
_load_tests(
@_
);
return
dclone(\
%TESTS
);
}
sub
normalize_test_result {
my
(
$doc
) =
@_
;
delete
$doc
->{
$_
}
for
@DELETE_KEYS
;
$doc
->{_json_error} =~ s{\s+at\s+\S+\s+line\s+\d+\.$}{}
if
$doc
->{_json_error};
return
$doc
;
}
1;