Mercurial > pub > Impl
view lib/IMPL/Object/_Base.pm @ 423:60c2892a577c ref20150831
working on base class system
author | cin |
---|---|
date | Mon, 02 Apr 2018 07:35:23 +0300 |
parents | |
children | 87af445663d7 |
line wrap: on
line source
package IMPL::Object::_Base; use strict; use mro; sub _build_ctor { my $class = shift; my @isa = reverse @{mro::get_linear_isa($class)}; } sub _get_ctor { my ($class, $prev, $t) = @_; no strict 'refs'; #say "_get_ctor($class, $prev, $t)"; my $isolate = ((not defined($t)) or ($t ne '@_')); my $ctor = $isolate ? *{"${class}::CTOR"}{CODE} : _chain_call(*{"${class}::CTOR"}{CODE}, $prev); foreach my $base (@{"${class}::ISA"}) { $ctor = _get_ctor($base, $ctor, exists ${"${class}::ISA"}{$base} ? ${"${class}::ISA"}{$base} : '@_'); } if ($isolate) { $ctor = _chain_call(_chain_params($ctor, $t), $prev); } return $ctor; } sub _chain_call { my ($method, $next) = @_; return $method unless $next; return $next unless $method; return sub { &$method(@_); goto &$next; } } sub _chain_params { my ($method, $prepare) = @_; return unless $method; if (not defined $prepare) { return sub { @_ = (shift); goto &$method }; } elsif ($prepare eq '@_') { return $method; } elsif (ref $prepare eq 'CODE') { return sub { @_ = (shift, &$prepare(@_)); goto &$method; } } } 1;