our
$VERSION
=
'1.22'
;
$VERSION
=
eval
$VERSION
;
our
$AUTHORITY
=
'cpan:STEVAN'
;
'Class::MOP::Method::Inlined'
;
sub
new {
my
$class
=
shift
;
my
%options
=
@_
;
(
ref
$options
{options} eq
'HASH'
)
||
$class
->throw_error(
"You must pass a hash of options"
,
data
=>
$options
{options});
(
$options
{package_name} &&
$options
{name})
||
$class
->throw_error(
"You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT"
);
my
$self
=
bless
{
'body'
=>
undef
,
'package_name'
=>
$options
{package_name},
'name'
=>
$options
{name},
'options'
=>
$options
{options},
'associated_metaclass'
=>
$options
{metaclass},
} =>
$class
;
weaken(
$self
->{
'associated_metaclass'
});
$self
->_initialize_body;
return
$self
;
}
sub
options { (
shift
)->{
'options'
} }
sub
is_needed {
my
$self
=
shift
;
my
$metaclass
=
shift
;
( blessed
$metaclass
&&
$metaclass
->isa(
'Class::MOP::Class'
) )
||
$self
->throw_error(
"The is_needed method expected a metaclass object as its arugment"
);
return
$metaclass
->find_method_by_name(
"DEMOLISHALL"
);
}
sub
initialize_body {
Carp::cluck(
'The initialize_body method has been made private.'
.
" The public version is deprecated and will be removed in a future release.\n"
);
shift
->_initialize_body;
}
sub
_initialize_body {
my
$self
=
shift
;
my
@DEMOLISH_methods
=
$self
->associated_metaclass->find_all_methods_by_name(
'DEMOLISH'
);
my
$source
;
$source
=
'sub {'
.
"\n"
;
$source
.=
'my $self = shift;'
.
"\n"
;
$source
.=
'return $self->Moose::Object::DESTROY(@_)'
.
"\n"
;
$source
.=
' if Scalar::Util::blessed($self) ne '
;
$source
.=
"'"
.
$self
->associated_metaclass->name .
"'"
;
$source
.=
';'
.
"\n"
;
if
(
@DEMOLISH_methods
) {
$source
.=
'local $?;'
.
"\n"
;
$source
.=
'my $in_global_destruction = Devel::GlobalDestruction::in_global_destruction;'
.
"\n"
;
$source
.=
'Try::Tiny::try {'
.
"\n"
;
$source
.=
'$self->'
.
$_
->{class} .
'::DEMOLISH($in_global_destruction);'
.
"\n"
for
@DEMOLISH_methods
;
$source
.=
'}'
;
$source
.=
q[ Try::Tiny::catch { no warnings 'misc'; die $_ };]
.
"\n"
;
$source
.=
'return;'
.
"\n"
;
}
$source
.=
'}'
;
warn
$source
if
$self
->options->{debug};
my
(
$code
,
$e
) =
$self
->_compile_code(
environment
=> {},
code
=>
$source
,
);
$self
->throw_error(
"Could not eval the destructor :\n\n$source\n\nbecause :\n\n$e"
,
error
=>
$e
,
data
=>
$source
)
if
$e
;
$self
->{
'body'
} =
$code
;
}
1;