Commit | Line | Data |
56ffe19d |
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}; |
31eec6e8 |
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 { |
19e0e749 |
23 | $self->DEMOLISHALL(Moo::_Utils::_in_global_destruction); |
31eec6e8 |
24 | }; |
25 | $@; |
26 | }; |
27 | |
28 | no warnings 'misc'; |
29 | die $e if $e; # rethrow |
30 | !; |
56ffe19d |
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; |