X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FPurePerl.pm;h=dcac898683b468c7d9bfb3975946cb2ce6127915;hp=d2f04f3b1db1b0f6daa9845d6e02623c36460728;hb=a5c683f611022dcabb13169162fa2f57ba72b200;hpb=1bbf836974b126038c8cfc3155a265c9f8d9d385 diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index d2f04f3..dcac898 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -203,9 +203,8 @@ sub add_method { package Mouse::Meta::Class; -use Mouse::Meta::Method::Constructor; - -sub constructor_class() { 'Mouse::Meta::Method::Constructor' } +sub constructor_class() { 'Mouse::Meta::Method::Constructor' } +sub destructor_class() { 'Mouse::Meta::Method::Destructor' } sub is_anon_class{ return exists $_[0]->{anon_serial_id}; @@ -437,6 +436,38 @@ sub new { return $self; } +sub DESTROY { + my $self = shift; + + return unless $self->can('DEMOLISH'); # short circuit + + local $?; + + my $e = do{ + local $@; + eval{ + + # DEMOLISHALL + + # We cannot count on being able to retrieve a previously made + # metaclass, _or_ being able to make a new one during global + # destruction. However, we should still be able to use mro at + # that time (at least tests suggest so ;) + + foreach my $class (@{ Mouse::Util::get_linear_isa(ref $self) }) { + my $demolish = Mouse::Util::get_code_ref($class, 'DEMOLISH') + || next; + + $self->$demolish(); + } + }; + $@; + }; + + no warnings 'misc'; + die $e if $e; # rethrow +} + 1; __END__