lib/Mouse/Meta/Method/Destructor.pm

   1 package Mouse::Meta::Method::Destructor;
   2 use Mouse::Util qw(get_code_ref); # 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         if (get_code_ref($class, 'DEMOLISH')) {
  16             $demolishall .= "${class}::DEMOLISH(\$self);\n";
  17         }
  18     }
  19
  20     my $source = sprintf("#line %d %s\n", __LINE__, __FILE__) . <<"...";
  21     sub {
  22         my \$self = shift;
  23         local \$?;
  24
  25         my \$e = do{
  26             local \$@;
  27             eval{
  28                 $demolishall;
  29             };
  30             \$@;
  31         };
  32         no warnings 'misc';
  33         die \$e if \$e; # rethrow
  34     }
  35 ...
  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.40_01
  57
  58 =head1 SEE ALSO
  59
  60 L<Moose::Meta::Method::Destructor>
  61
  62 =cut