lib/Mouse/Meta/Method/Destructor.pm

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