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}; |
16 | } |
17 | |
18 | sub demolishall_body_for { |
19 | my ($self, $into, $me, $args) = @_; |
20 | my @demolishers = |
21 | grep *{_getglob($_)}{CODE}, |
22 | map "${_}::DEMOLISH", |
23 | @{Moo::_Utils::_get_linear_isa($into)}; |
24 | join '', map qq{ ${me}->${_}(${args});\n}, @demolishers; |
25 | } |
26 | |
27 | sub _handle_subdemolish { |
28 | my ($self, $into) = @_; |
29 | ' if (ref($_[0]) ne '.perlstring($into).') {'."\n". |
30 | ' return shift->Moo::Object::DEMOLISHALL(@_)'.";\n". |
31 | ' }'."\n"; |
32 | } |
33 | |
34 | 1; |