X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod%2FDestructor.pm;h=7775a14f76befc309917f596dfc607fa170215f9;hb=380e1cd7159fdf0efd57348736ca901825e1e4e8;hp=935be3b2b70fce600ee31cb34f9c40cddd121c96;hpb=0c15085d773ac3c69ac27b4d515895a97bd55b3d;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Method/Destructor.pm b/lib/Mouse/Meta/Method/Destructor.pm index 935be3b..7775a14 100644 --- a/lib/Mouse/Meta/Method/Destructor.pm +++ b/lib/Mouse/Meta/Method/Destructor.pm @@ -1,37 +1,38 @@ package Mouse::Meta::Method::Destructor; -use strict; -use warnings; +use Mouse::Util; # enables strict and warnings -sub generate_destructor_method_inline { - my ($class, $meta) = @_; +sub _empty_DESTROY{ } - my $demolishall = do { - if ($meta->name->can('DEMOLISH')) { - my @code = (); - no strict 'refs'; - for my $klass ($meta->linearized_isa) { - if (*{$klass . '::DEMOLISH'}{CODE}) { - push @code, "${klass}::DEMOLISH(\$self);"; - } - } - join "\n", @code; - } else { - return 'sub { }'; # no demolish =) +sub _generate_destructor{ + my (undef, $metaclass) = @_; + + if(!$metaclass->name->can('DEMOLISH')){ + return \&_empty_DESTROY; + } + + my $demolishall = ''; + for my $class ($metaclass->linearized_isa) { + no strict 'refs'; + if (*{$class . '::DEMOLISH'}{CODE}) { + $demolishall .= "${class}::DEMOLISH(\$self);\n"; } - }; + } - my $code = <<"..."; + my $source = sprintf("#line %d %s\n", __LINE__, __FILE__) . <<"..."; sub { my \$self = shift; $demolishall; } ... - warn $code if $ENV{DEBUG}; - 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;