lib/Mouse/Meta/Method/Destructor.pm

   1 package Mouse::Meta::Method::Destructor;
   2 use strict;
   3 use warnings;
   4
   5 sub generate_destructor_method_inline {
   6     my ($class, $meta) = @_;
   7
   8     my $demolishall = do {
   9         if ($meta->name->can('DEMOLISH')) {
  10             my @code = ();
  11             no strict 'refs';
  12             for my $klass ($meta->linearized_isa) {
  13                 if (*{$klass . '::DEMOLISH'}{CODE}) {
  14                     push @code, "${klass}::DEMOLISH(\$self);";
  15                 }
  16             }
  17             join "\n", @code;
  18         } else {
  19             return; # no demolish =)
  20         }
  21     };
  22
  23     my $code = <<"...";
  24     sub {
  25         my \$self = shift;
  26         $demolishall;
  27     }
  28 ...
  29     warn $code if $ENV{DEBUG};
  30
  31     local $@;
  32     my $res = eval $code;
  33     die $@ if $@;
  34     return $res;
  35 }
  36
  37 1;