X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod%2FDestructor.pm;h=c3d2a0da691bb21ee12d3d18dc144b540712560b;hb=2a464664052830d5fad036569d5ccb3964c7f592;hp=fa0d0253c479b587ac2b61e840a0a61cbcbc951c;hpb=cfa6d970245f1bbc9330c0e4bb3342356a43ac16;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Method/Destructor.pm b/lib/Mouse/Meta/Method/Destructor.pm index fa0d025..c3d2a0d 100644 --- a/lib/Mouse/Meta/Method/Destructor.pm +++ b/lib/Mouse/Meta/Method/Destructor.pm @@ -2,13 +2,15 @@ package Mouse::Meta::Method::Destructor; use strict; use warnings; -sub generate_destructor_method_inline { - my ($class, $meta) = @_; +sub _empty_destroy{ } + +sub _generate_destructor_method { + my ($class, $metaclass) = @_; my $demolishall = do { - if ($meta->name->can('DEMOLISH')) { + if ($metaclass->name->can('DEMOLISH')) { my @code = (); - for my $class ($meta->linearized_isa) { + for my $class ($metaclass->linearized_isa) { no strict 'refs'; if (*{$class . '::DEMOLISH'}{CODE}) { push @code, "${class}::DEMOLISH(\$self);"; @@ -16,21 +18,26 @@ sub generate_destructor_method_inline { } join "\n", @code; } else { - return sub { }; # no demolish =) + $metaclass->add_method(DESTROY => \&_empty_destroy); + return; } }; - my $code = <<"..."; - sub { + my $destructor_name = $metaclass->name . '::DESTROY'; + my $code = sprintf("#line %d %s\n", __LINE__, __FILE__) . <<"..."; + sub $destructor_name \{ my \$self = shift; $demolishall; } ... - local $@; - my $res = eval $code; + my $e = do{ + local $@; + eval $code; + $@; + }; die $@ if $@; - return $res; + return; } 1;