X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod%2FDestructor.pm;h=81323dca5a7f330873c265f25f8a77cb33e06c99;hp=fa0d0253c479b587ac2b61e840a0a61cbcbc951c;hb=8c235ea79c109c704514acd56b10265220499d70;hpb=7ca5c5fb6e084d9c57bc022b336458afc74c6847 diff --git a/lib/Mouse/Meta/Method/Destructor.pm b/lib/Mouse/Meta/Method/Destructor.pm index fa0d025..81323dc 100644 --- a/lib/Mouse/Meta/Method/Destructor.pm +++ b/lib/Mouse/Meta/Method/Destructor.pm @@ -1,36 +1,62 @@ package Mouse::Meta::Method::Destructor; -use strict; -use warnings; - -sub generate_destructor_method_inline { - my ($class, $meta) = @_; - - my $demolishall = do { - if ($meta->name->can('DEMOLISH')) { - my @code = (); - for my $class ($meta->linearized_isa) { - no strict 'refs'; - if (*{$class . '::DEMOLISH'}{CODE}) { - push @code, "${class}::DEMOLISH(\$self);"; - } - } - join "\n", @code; - } else { - return sub { }; # no demolish =) +use Mouse::Util qw(:meta); # enables strict and warnings + +sub _empty_DESTROY{ } + +sub _generate_destructor{ + my (undef, $metaclass) = @_; + + if(!$metaclass->name->can('DEMOLISH')){ + return \&_empty_DESTROY; + } + + my $demolishall = ''; + for my $class ($metaclass->linearized_isa) { + if (Mouse::Util::get_code_ref($class, 'DEMOLISH')) { + $demolishall .= "${class}::DEMOLISH(\$self);\n"; } - }; + } - my $code = <<"..."; + my $source = sprintf("#line %d %s\n", __LINE__, __FILE__) . <<"..."; sub { my \$self = shift; - $demolishall; + local \$?; + + my \$e = do{ + local \$@; + eval{ + $demolishall; + }; + \$@; + }; + no warnings 'misc'; + die \$e if \$e; # rethrow } ... - local $@; - my $res = eval $code; - die $@ if $@; - return $res; + my $code; + my $e = do{ + local $@; + $code = eval $source; + $@; + }; + die $e if $e; + return $code; } 1; +__END__ + +=head1 NAME + +Mouse::Meta::Method::Destructor - A Mouse method generator for destructors + +=head1 VERSION + +This document describes Mouse version 0.46 + +=head1 SEE ALSO + +L + +=cut