lib/Method/Generate/DemolishAll.pm

   1 package Method::Generate::DemolishAll;
   2
   3 use strictures 1;
   4 use base qw(Moo::Object);
   5 use Sub::Quote;
   6 use Moo::_Utils;
   7 use B qw(perlstring);
   8
   9 sub generate_method {
  10   my ($self, $into) = @_;
  11   quote_sub "${into}::DEMOLISHALL", join '',
  12     $self->_handle_subdemolish($into),
  13     qq{    my \$self = shift;\n},
  14     $self->demolishall_body_for($into, '$self', '@_'),
  15     qq{    return \$self\n};
  16   quote_sub "${into}::DESTROY", join '',
  17     q!    my $self = shift;
  18     my $e = do {
  19       local $?;
  20       local $@;
  21       require Moo::_Utils;
  22       eval {
  23         $self->DEMOLISHALL($Moo::_Utils::_in_global_destruction);
  24       };
  25       $@;
  26     };
  27
  28     no warnings 'misc';
  29     die $e if $e; # rethrow
  30   !;
  31 }
  32
  33 sub demolishall_body_for {
  34   my ($self, $into, $me, $args) = @_;
  35   my @demolishers =
  36     grep *{_getglob($_)}{CODE},
  37     map "${_}::DEMOLISH",
  38     @{Moo::_Utils::_get_linear_isa($into)};
  39   join '', map qq{    ${me}->${_}(${args});\n}, @demolishers;
  40 }
  41
  42 sub _handle_subdemolish {
  43   my ($self, $into) = @_;
  44   '    if (ref($_[0]) ne '.perlstring($into).') {'."\n".
  45   '      return shift->Moo::Object::DEMOLISHALL(@_)'.";\n".
  46   '    }'."\n";
  47 }
  48
  49 1;