sub
run_test {
my
$test
=
shift
;
my
$valid
=
$test
->{valid};
my
$mc
;
my
$err
= exception {
$mc
= MongoDB->
connect
(
$test
->{uri} ) };
if
( !
$valid
) {
isnt(
$err
,
undef
,
"invalid uri"
);
return
;
}
is(
$err
,
undef
,
"valid parse"
);
my
$cred
=
$mc
->_credential;
ok(
$cred
,
"credential created"
) or
return
;
if
( !
$test
->{credential} ) {
is(
$cred
->mechanism,
"NONE"
,
"credential should not be configured"
);
return
;
}
my
$test_cred
=
$test
->{credential};
is(
$cred
->source,
$test_cred
->{source},
"source"
)
if
exists
$test_cred
->{source};
is(
uc
$cred
->mechanism ,
uc
(
$test_cred
->{mechanism} //
"DEFAULT"
),
"mechanism"
)
if
exists
$test_cred
->{mechanism};
is(
$cred
->username,
$test_cred
->{username},
"username"
)
if
exists
$test_cred
->{username};
is(
$cred
->password,
$test_cred
->{password},
"password"
)
if
exists
$test_cred
->{password};
if
(
exists
$test_cred
->{mechanism_properties} ) {
my
$test_prop
=
$test_cred
->{mechanism_properties};
my
$cred_prop
=
$cred
->mechanism_properties;
for
my
$k
(
keys
%$test_prop
) {
is(
$cred_prop
->{
$k
},
$test_prop
->{
$k
},
"authMechanismProperties: $k"
)
}
}
}
my
$dir
= path(
"t/data/auth"
);
my
$iterator
=
$dir
->iterator;
my
$json
= JSON::MaybeXS->new;
while
(
my
$path
=
$iterator
->() ) {
next
unless
$path
=~ /\.json$/;
my
$plan
=
eval
{
$json
->decode(
$path
->slurp_utf8 ) };
if
($@) {
die
"Error decoding $path: $@"
;
}
subtest
$path
=>
sub
{
for
my
$test
( @{
$plan
->{tests} } ) {
my
$description
=
$test
->{description};
subtest
$description
=>
sub
{ run_test(
$test
); }
}
}
}
done_testing;