lib/Mouse/Meta/Method/Destructor.pm

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