X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod%2FDestructor.pm;h=681cfaa58cb8fd187c8c0cddddbddb7f600e66df;hb=ad087d1140e1f90a85f2f47cc05bd648fb4ea38e;hp=09e23bc938c87d28430d3e0fcfb38ca987fa5751;hpb=8da68341396129a1b4545299fda0fae7e9cf6d56;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Method/Destructor.pm b/lib/Mouse/Meta/Method/Destructor.pm index 09e23bc..681cfaa 100644 --- a/lib/Mouse/Meta/Method/Destructor.pm +++ b/lib/Mouse/Meta/Method/Destructor.pm @@ -2,36 +2,42 @@ 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 = (); - no strict 'refs'; - for my $klass ($meta->linearized_isa) { - if (*{$klass . '::DEMOLISH'}{CODE}) { - push @code, "${klass}::DEMOLISH(\$self);"; + for my $class ($metaclass->linearized_isa) { + no strict 'refs'; + if (*{$class . '::DEMOLISH'}{CODE}) { + push @code, "${class}::DEMOLISH(\$self);"; } } join "\n", @code; } else { - return; # no demolish =) + $metaclass->add_method(DESTROY => \&_empty_destroy); + return; } }; - my $code = <<"..."; - sub { + my $destructor_name = $metaclass->name . '::DESTROY'; + my $source = sprintf("#line %d %s\n", __LINE__, __FILE__) . <<"..."; + sub $destructor_name \{ my \$self = shift; $demolishall; } ... - warn $code if $ENV{DEBUG}; - local $@; - my $res = eval $code; - die $@ if $@; - return $res; + my $e = do{ + local $@; + eval $source; + $@; + }; + die $e if $e; + return; } 1;