our
@EXPORT_OK
=
qw/local_umask stacktrace/
;
sub
local_umask {
return
unless
defined
$Config
{d_umask};
die
'Calling local_umask() in void context makes no sense'
if
!
defined
wantarray
;
my
$old_umask
=
umask
(
shift
());
die
"Setting umask failed: $!"
unless
defined
$old_umask
;
return
bless
\
$old_umask
,
'DBICTest::Util::UmaskGuard'
;
}
{
sub
DESTROY {
local
($@, $!);
eval
{
defined
(
umask
${
$_
[0]}) or
die
};
warn
(
"Unable to reset old umask ${$_[0]}: "
. ($!||
'Unknown error'
) )
if
($@ || $!);
}
}
sub
stacktrace {
my
$frame
=
shift
;
$frame
++;
my
(
@stack
,
@frame
);
while
(
@frame
=
caller
(
$frame
++)) {
push
@stack
, [
@frame
[3,1,2]];
}
return
undef
unless
@stack
;
$stack
[0][0] =
''
;
return
join
"\tinvoked as "
,
map
{
sprintf
(
"%s at %s line %d\n"
,
@$_
) }
@stack
;
}
1;