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=db966423c21ecad9b97542f03678c1c0e32cd1d8;hp=c3d2a0da691bb21ee12d3d18dc144b540712560b;hb=70a922201a3b13a22b86ea918f53d3b964c377c7;hpb=2a464664052830d5fad036569d5ccb3964c7f592 diff --git a/lib/Mouse/Meta/Method/Destructor.pm b/lib/Mouse/Meta/Method/Destructor.pm index c3d2a0d..db96642 100644 --- a/lib/Mouse/Meta/Method/Destructor.pm +++ b/lib/Mouse/Meta/Method/Destructor.pm @@ -1,43 +1,64 @@ package Mouse::Meta::Method::Destructor; -use strict; -use warnings; - -sub _empty_destroy{ } - -sub _generate_destructor_method { - my ($class, $metaclass) = @_; - - my $demolishall = do { - if ($metaclass->name->can('DEMOLISH')) { - my @code = (); - for my $class ($metaclass->linearized_isa) { - no strict 'refs'; - if (*{$class . '::DEMOLISH'}{CODE}) { - push @code, "${class}::DEMOLISH(\$self);"; - } - } - join "\n", @code; - } else { - $metaclass->add_method(DESTROY => \&_empty_destroy); - return; +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 .= sprintf "%s::DEMOLISH(\$self, \$Mouse::Util::in_global_destruction);\n", + $class, } - }; + } - my $destructor_name = $metaclass->name . '::DESTROY'; - my $code = sprintf("#line %d %s\n", __LINE__, __FILE__) . <<"..."; - sub $destructor_name \{ - my \$self = shift; - $demolishall; + my $source = sprintf(<<'END_DESTROY', __LINE__, __FILE__, $demolishall); +#line %d %s + sub { + my $self = shift; + my $e = do{ + local $?; + local $@; + eval{ + # demolishall + %s; + }; + $@; + }; + no warnings 'misc'; + die $e if $e; # rethrow } -... +END_DESTROY + my $code; my $e = do{ local $@; - eval $code; + $code = eval $source; $@; }; - die $@ if $@; - return; + 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.50_03 + +=head1 SEE ALSO + +L + +=cut