changeset 412:30e8c6a74937 ref20150831

working on di container (role based registrations)
author cin
date Mon, 21 Sep 2015 19:54:10 +0300
parents ee36115f6a34
children af8d359ee4cc
files _test/temp.pl lib/IMPL/Config/Bag.pm lib/IMPL/Config/Container.pm lib/IMPL/Config/Hierarchy.pm lib/IMPL/lang.pm
diffstat 5 files changed, 177 insertions(+), 6 deletions(-) [+]
line wrap: on
line diff
--- 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;
--- /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
--- 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
--- /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;
--- 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($) {