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