# HG changeset patch # User cin # Date 1442854450 -10800 # Node ID 30e8c6a749370c8cecba89a654cfaff43a42c26a # Parent ee36115f6a34253fdfb5e2982261a3979af8f5fa working on di container (role based registrations) diff -r ee36115f6a34 -r 30e8c6a74937 _test/temp.pl --- a/_test/temp.pl Mon Sep 21 00:53:10 2015 +0300 +++ b/_test/temp.pl Mon Sep 21 19:54:10 2015 +0300 @@ -1,9 +1,48 @@ #!/usr/bin/perl use strict; +use Carp; +use Time::HiRes qw(gettimeofday tv_interval); +use Scalar::Util qw(blessed); +my $slot; +my $ref = bless \$slot, 'Wrapper'; +sub is { + my $slot = shift; + bless \$slot, 'Wrapper'; +} -use IMPL::require { ServicesBag => 'IMPL::Config::ServicesBag' }; +sub instanceOf { + carp "A typename can't be undefined" unless $_[1]; + blessed($_[0]) and $_[0]->isa($_[1]) +} + +my $bar = Bar->new(); + +my $t = [gettimeofday]; -my $root = ServicesBag->new(); +for(my $i =0; $i< 1000000; $i++) { + is($bar)->instanceOf('Bar'); +} + +print "Is: ",tv_interval($t,[gettimeofday]),"\n"; + +$t = [gettimeofday]; + +for(my $i =0; $i< 1000000; $i++) { + instanceOf($bar, 'Bar'); +} + +print "Is: ",tv_interval($t,[gettimeofday]),"\n"; +package Wrapper; +use Scalar::Util qw(blessed); +sub instanceOf { + blessed(${$_[0]}) and ${$_[0]}->isa($_[1]); +} + +package Bar; +use IMPL::declare { + base => ['IMPL::Object' => undef] +}; + 1; diff -r ee36115f6a34 -r 30e8c6a74937 lib/IMPL/Config/Bag.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/IMPL/Config/Bag.pm Mon Sep 21 19:54:10 2015 +0300 @@ -0,0 +1,16 @@ +package IMPL::Config::Bag; +use strict; + +use IMPL::declare { + +}; + +sub Resolve { + +} + +sub Register { + +} + +1; \ No newline at end of file diff -r ee36115f6a34 -r 30e8c6a74937 lib/IMPL/Config/Container.pm --- a/lib/IMPL/Config/Container.pm Mon Sep 21 00:53:10 2015 +0300 +++ b/lib/IMPL/Config/Container.pm Mon Sep 21 19:54:10 2015 +0300 @@ -1,4 +1,40 @@ package IMPL::Config::Container; +use strict; + +use IMPL::lang qw(:base); +use IMPL::declare { + require => { + Descriptor => 'IMPL::Config::Descriptor' + }, + base => [ + 'IMPL::Object' => undef + ], + props => [ + roles => 'r', + services => 'r', + instances => 'r' + ] +}; + +my $nextRoleId = 1; + +use IMPL::Exception(); + +sub Register { + my ($this, $role, $service) = @_; + + die IMPL::InvalidArgumentException->new(role => 'The argument is required') unless $role; + die IMPL::InvalidArgumentException->new('service') unless is($service, Descriptor); + + if (isarray($role)) { + my $tempRole = "unnamed-" . $nextRoleId++; + $this->role->AddRole($tempRole, $role); + $role = $tempRole; + } + + $this->services->Register($role, $service); + +} 1; @@ -31,4 +67,4 @@ =head3 RegisterService($descriptor) -=cut \ No newline at end of file +=cut diff -r ee36115f6a34 -r 30e8c6a74937 lib/IMPL/Config/Hierarchy.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/IMPL/Config/Hierarchy.pm Mon Sep 21 19:54:10 2015 +0300 @@ -0,0 +1,71 @@ +package IMPL::Config::Hierarchy; +use strict; + +use IMPL::Exception(); +use IMPL::lang qw(:base); +use IMPL::clone; +use IMPL::declare { + base => { + 'IMPL::Object' => undef + }, + props => { + roles => '*rw', + _cache => '*rw' + } +}; + +sub CTOR { + my ( $this, $roles ) = @_; + + if ( is( $roles, SELF ) ) { + $this->roles( clone( $roles->roles ) ); + } + elsif ( ishash($roles) ) { + $this->roles($roles); + } + elsif ( isarray($roles) ) { + $this->roles( { map { $_, 1 } @$roles } ); + } + else { + $this->roles( {} ); + } +} + +sub AddRole { + my ( $this, $role, $parent ) = @_; + + $parent = isarray($parent) ? $parent : [$parent] + if $parent; + + die IMPL::InvalidArgumentException->new('role') unless $role; + + $this->roles->{$role} = $parent; +} + +sub GetLinearRoleHash { + my ( $this, $role ) = @_; + + return [] unless $role; + + my $cache = $this->{$_cache}{$role}; + + unless ($cache) { + $cache = {}; + + my @roles = ($role); + + while (my $r = shift @roles ) { + next if $cache->{$r}; + + $cache->{$r} = 1; + if(my $parents = $this->{$roles}{$r}) { + push @roles, @$parents; + } + } + $this->{$_cache}{$role} = $cache; + } + + return $cache; +} + +1; diff -r ee36115f6a34 -r 30e8c6a74937 lib/IMPL/lang.pm --- a/lib/IMPL/lang.pm Mon Sep 21 00:53:10 2015 +0300 +++ b/lib/IMPL/lang.pm Mon Sep 21 19:54:10 2015 +0300 @@ -17,6 +17,8 @@ &clone &isclass &typeof + &ishash + &isarray ) ], @@ -65,7 +67,7 @@ use IMPL::Const qw(:all); -sub is($$) { +sub is { carp "A typename can't be undefined" unless $_[1]; blessed($_[0]) and $_[0]->isa( $_[1] ); } @@ -77,8 +79,15 @@ } sub typeof(*) { - local $@; - eval { $_[0]->_typeof } || blessed($_[0]) || ref($_[0]); + blessed($_[0]); +} + +sub isarray { + not blessed($_[0]) and ref $_[0] eq 'ARRAY'; +} + +sub ishash { + not blessed($_[0]) and ref $_[0] eq 'HASH'; } sub public($) {