Mercurial > pub > Impl
diff _test/temp.pl @ 423:60c2892a577c ref20150831
working on base class system
author | cin |
---|---|
date | Mon, 02 Apr 2018 07:35:23 +0300 |
parents | b0481c071bea |
children | 87af445663d7 |
line wrap: on
line diff
--- a/_test/temp.pl Sun Aug 20 00:20:41 2017 +0300 +++ b/_test/temp.pl Mon Apr 02 07:35:23 2018 +0300 @@ -1,5 +1,6 @@ #!/usr/bin/perl use strict; +use v5.10; use Carp; use Time::HiRes qw(gettimeofday tv_interval); use Scalar::Util qw(blessed refaddr); @@ -7,31 +8,121 @@ use Data::Dumper; use URI; +#my $method = _get_ctor("Box", undef, '@_'); -use IMPL::require { - Container => 'IMPL::Config::Container', - Service => 'IMPL::Config::ServiceDescriptor', - Reference => 'IMPL::Config::ReferenceDescriptor', - Value => 'IMPL::Config::ValueDescriptor', - YAMLConfig => 'IMPL::Config::YAMLConfig' -}; +_invoke_ctor("main","x","y","z"); +_invoke_ctor("main","x","y","z"); + +sub _invoke_ctor { + my ($self) = @_; + no strict 'refs'; + no warnings 'redefine'; + + my $method = _get_ctor("Box", undef, '@_'); + + *{"${self}::_invoke_ctor"} = $method; + + goto &$method; +} +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; } +} -my $t = [gettimeofday]; -my $config = YAMLConfig->new(load => 'sample.yaml'); -print "Loaded: ",tv_interval($t,[gettimeofday]),"\n"; +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; + } + } +} -my $container = Container->new()->AutoPtr; -$config->ConfigureContainer($container); +package Obj; + +sub CTOR { + say "Obj ", join (',', @_); + say Carp::longmess(); +} +package Foo; + +BEGIN { + our @ISA = qw(Obj); + our %ISA = ( + Obj => sub { "hi" } + ); +} +sub CTOR { + say "Foo ", join (',', @_); +} -print "Configured: ",tv_interval($t,[gettimeofday]),"\n"; -#print Data::Dumper->Dump([$container]); -#$container->Dispose(); +package Bar; + +BEGIN { + our @ISA = qw(Foo); + our %ISA = ( + Foo => undef + ); +} + +sub CTOR { + say "Bar ", join(',', @_); +} + +package Baz; -my $base = URI->new('some/path'); -my $rel = URI->new('../other/path')->abs($base)->rel('/'); -print $rel,"\n"; +sub CTOR { + say "Baz ", join(',', @_); +} + +package Box; + +BEGIN { + our @ISA = qw(Bar Baz); + our %ISA = ( + Bar => sub { shift . "~Box->Bar", @_; }, + Baz => sub { shift . "~Box->Baz", @_; } + ); +} + +sub CTOR { + say "Box ", join(',', @_); +} 1;