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 _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 (Mouse::Util::get_code_ref($class, 'DEMOLISH')) {
  16             $demolishall .= sprintf "%s::DEMOLISH(\$self, \$Mouse::Util::in_global_destruction);\n",
  17                 $class,
  18         }
  19     }
  20
  21     my $source = sprintf("#line %d %s\n", __LINE__, __FILE__) . <<"...";
  22     sub {
  23         my \$self = shift;
  24         local \$?;
  25
  26         my \$e = do{
  27             local \$@;
  28             eval{
  29                 $demolishall;
  30             };
  31             \$@;
  32         };
  33         no warnings 'misc';
  34         die \$e if \$e; # rethrow
  35     }
  36 ...
  37
  38     my $code;
  39     my $e = do{
  40         local $@;
  41         $code = eval $source;
  42         $@;
  43     };
  44     die $e if $e;
  45     return $code;
  46 }
  47
  48 1;
  49 __END__
  50
  51 =head1 NAME
  52
  53 Mouse::Meta::Method::Destructor - A Mouse method generator for destructors
  54
  55 =head1 VERSION
  56
  57 This document describes Mouse version 0.50_02
  58
  59 =head1 SEE ALSO
  60
  61 L<Moose::Meta::Method::Destructor>
  62
  63 =cut