use
5.008001;
our
@EXPORT
=
qw/sv_type packed_is bytes_are to_extjson to_myjson try_or_fail/
;
my
$json_codec
= JSON::MaybeXS->new(
ascii
=> 1,
pretty
=> 0,
canonical
=> 1,
allow_blessed
=> 1,
convert_blessed
=> 1,
);
sub
to_extjson {
local
$ENV
{BSON_EXTJSON} = 1;
return
$json_codec
->encode(
shift
);
}
sub
to_myjson {
return
$json_codec
->encode(
shift
);
}
sub
sv_type {
my
$v
=
shift
;
my
$b_obj
= B::svref_2object( \
$v
);
my
$type
=
ref
(
$b_obj
);
$type
=~ s/^B:://;
return
$type
;
}
sub
packed_is {
croak(
"Not enough args for packed_is()"
)
unless
@_
>= 3;
my
(
$template
,
$got
,
$exp
,
$label
) =
@_
;
$label
=
''
unless
defined
$label
;
local
$Test::Builder::Level
=
$Test::Builder::Level
+ 1;
my
$ok
;
if
(
$template
eq
'q'
&& !
$Config
{use64bitint} ) {
if
( !
ref
(
$got
) && !
ref
(
$exp
) ) {
$template
=
'l'
;
}
else
{
$ok
= ok(
$got
eq
$exp
,
$label
);
diag
"Got: $got, Expected: $exp"
unless
$ok
;
return
$ok
;
}
}
$ok
= ok(
pack
(
$template
,
$got
) eq
pack
(
$template
,
$exp
),
$label
);
diag
"Got: $got, Expected: $exp"
unless
$ok
;
return
$ok
;
}
sub
bytes_are {
croak(
"Not enough args for bytes_are()"
)
unless
@_
>= 2;
my
(
$got
,
$exp
,
$label
) =
@_
;
$label
=
''
unless
defined
$label
;
local
$Test::Builder::Level
=
$Test::Builder::Level
+ 1;
my
$ok
= ok(
$got
eq
$exp
,
$label
);
diag
"Got:\n"
,
unpack
(
"H*"
,
$got
),
"\nExpected:\n"
,
unpack
(
"H*"
,
$exp
)
unless
$ok
;
return
$ok
;
}
sub
try_or_fail {
my
(
$code
,
$label
) =
@_
;
eval
{
$code
->() };
if
(
my
$err
= $@ ) {
fail(
$label
);
diag
"Error:\n$err"
;
return
;
}
return
1;
}
1;