Mercurial > pub > Impl
diff lib/IMPL/Object/_Base.pm @ 424:87af445663d7 ref20150831
IMPL::Object::_Base
author | cin |
---|---|
date | Tue, 03 Apr 2018 10:54:09 +0300 |
parents | 60c2892a577c |
children | c27434cdd611 |
line wrap: on
line diff
--- a/lib/IMPL/Object/_Base.pm Mon Apr 02 07:35:23 2018 +0300 +++ b/lib/IMPL/Object/_Base.pm Tue Apr 03 10:54:09 2018 +0300 @@ -1,13 +1,53 @@ package IMPL::Object::_Base; use strict; +use warnings; use mro; -sub _build_ctor { - my $class = shift; +sub __construct; +sub __destroy; + +*__construct = _strap_ctor(__PACKAGE__); +*__destroy = _strap_dtor(__PACKAGE__); + +sub DESTROY { + shift->__destroy(); +} + +sub _strap_ctor { + my ($class, $ctor) = @_; + no strict 'refs'; + no warnings 'redefine'; - my @isa = reverse @{mro::get_linear_isa($class)}; + return sub { + my $self = ref shift; + + if ($self ne $class) { + my $t = _get_ctor($self, undef, '@_'); + *{"${self}::__construct"} = _strap_ctor($self, $t); + goto &$t if $t; + } else { + goto &$ctor if $ctor; + } + }; +} + +sub _strap_dtor { + my ($class, $dtor) = @_; + no strict 'refs'; + no warnings 'redefine'; + return sub { + my $self = ref shift; + + if ($self ne $class) { + my $t = _get_dtor($self); + *{"${self}::__destroy"} = _strap_dtor($self, $t); + goto &$t if $t; + } else { + goto &$dtor if $dtor; + } + }; } sub _get_ctor { @@ -31,6 +71,16 @@ return $ctor; } +sub _get_dtor { + my ($class, $prev) = @_; + no strict 'refs'; + + my $dtor = _chain_call(*{"${class}::DTOR"}{CODE}, $prev); + $dtor = _get_dtor($_, $dtor) foreach @{"${class}::ISA"}; + + return $dtor; +} + sub _chain_call { my ($method, $next) = @_;