lib/Mouse/Meta/Method/Destructor.pm

   1 package Mouse::Meta::Method::Destructor;
   2 use Mouse::Util qw(:meta); # enables strict and warnings
   3
   4 sub _generate_destructor{
   5     my (undef, $metaclass) = @_;
   6
   7     my $demolishall = '';
   8     for my $class ($metaclass->linearized_isa) {
   9         if (Mouse::Util::get_code_ref($class, 'DEMOLISH')) {
  10             $demolishall .= sprintf "%s::DEMOLISH(\$self, \$Mouse::Util::in_global_destruction);\n",
  11                 $class,
  12         }
  13     }
  14
  15     my $name   = $metaclass->name;
  16     my $source = sprintf(<<'EOT', __LINE__, __FILE__, $name, $demolishall);
  17 #line %d %s
  18     package %s;
  19     sub {
  20         my $self = shift;
  21         return $self->Mouse::Object::DESTROY()
  22             if ref($self) ne __PACKAGE__;
  23         my $e = do{
  24             local $?;
  25             local $@;
  26             eval{
  27                 # demolishall
  28                 %s;
  29             };
  30             $@;
  31         };
  32         no warnings 'misc';
  33         die $e if $e; # rethrow
  34     }
  35 EOT
  36
  37     my $code;
  38     my $e = do{
  39         local $@;
  40         $code = eval $source;
  41         $@;
  42     };
  43     die $e if $e;
  44     return $code;
  45 }
  46
  47 1;
  48 __END__
  49
  50 =head1 NAME
  51
  52 Mouse::Meta::Method::Destructor - A Mouse method generator for destructors
  53
  54 =head1 VERSION
  55
  56 This document describes Mouse version 0.71
  57
  58 =head1 SEE ALSO
  59
  60 L<Moose::Meta::Method::Destructor>
  61
  62 =cut