diff lib/IMPL/Config/Bag.pm @ 415:3d24b10dd0d5 ref20150831

working on IMPL::Config::Container
author cin
date Tue, 20 Oct 2015 07:32:55 +0300
parents ec6f2d389d1e
children 3ed0c58e9da3
line wrap: on
line diff
--- a/lib/IMPL/Config/Bag.pm	Fri Oct 02 06:56:24 2015 +0300
+++ b/lib/IMPL/Config/Bag.pm	Tue Oct 20 07:32:55 2015 +0300
@@ -8,7 +8,8 @@
 	],
 	props => [
 		_parents   => '*rw',    # array of parent bags
-		_state     => '*rw',    #array of previous timestamps
+		_parentRev => '*rw',    # the timestamp of the parent
+		_sealed    => '*rw',    # the bag has descendants
 		_cache     => '*rw',    # own or cached entries
 		_timestamp => '*rw',
 		_entries   => '*rw',    # each entry is represented by hash
@@ -20,11 +21,12 @@
 	my ( $this, $p ) = @_;
 
 	if ($p) {
+		$p->_Seal();
 		my @parents;
 		push @parents, @{ $p->{$_parents} } if $p->{$_parents};
 		push @parents, $p;
-		$this->{$_parents} = \@parents;
-		$this->{$_state} = [ map $_->{$_timestamp}, @parents ];
+		$this->{$_parents}   = \@parents;
+		$this->{$_parentRev} = $p->{$_timestamp};
 	}
 
 	$this->{$_timestamp} = 0;
@@ -33,40 +35,47 @@
 }
 
 sub GetParent {
-	$_[0]->{$_parents} && $_[0]->{$_parents}[0];
+	my ($this) = @_;
+
+	$this->{$_parents} && $this->{$_parents}[ @{ $this->{$_parents} } - 1 ];
+}
+
+sub _Seal {
+	unless ($_[0]->{$_sealed}) {
+		$_[0]->{$_sealed} = 1;
+		$_[0]->{$_timestamp} = 0; # from now the timestamp is important
+	}
 }
 
 sub _Validate {
 	my ($this) = @_;
 
-	my $parents = $this->{$_parents}
-	  or return;
-	my $state = $this->{$_state};
-	my $len   = @$parents;
-	my $flush;
+	my $chain = $this->{$_parents}
+	  or return 1;
 
-	for ( my $i = 0 ; $i < $len ; $i++ ) {
-		if ($flush) {
-			$parents->[$i]{$_cache} = {};
-			$state->[$i] = $parents->[$i]{$_timestamp};
-		}
-		else {
-			$flush = ( $parents->[$i]{$_timestamp} != $state->[$i] );
-		}
+	my $rev = 0; # rev 0 means that parent was never modified
+	            # this allows to made more efficient checks
+	my $flush;
+	
+	foreach my $bag (@$chain, $this) {
+		# we need to updated all bags after the first change was detected;
+        if ($flush ||= $rev and $bag->{$_parentRev} != $rev) {
+            $bag->{$_cache} = {};
+            $bag->{$_parentRev} = $rev;
+        }
+        $rev = $bag->{$_timestamp};
 	}
-
-	if ($flush) {
-		$this->{$_cache} = {};
-		return 0;
-	}
-
-	return 1;
+	
+	return $flush ? 0 : 1;
 }
 
 sub Resolve {
 	my ( $this, $role ) = @_;
 
-	if ( my $d = $this->GetDescriptor() ) {
+	die IMPL::InvalidArgumentException->new('role')
+	  unless defined $role;
+
+	if ( my $d = $this->_GetDescriptor($role) ) {
 		return $d->{value};
 	}
 	else {
@@ -74,7 +83,7 @@
 	}
 }
 
-sub GetDescriptor {
+sub _GetDescriptor {
 	my ( $this, $role ) = @_;
 
 	my $d = $this->{$_cache}{$role};
@@ -86,6 +95,10 @@
 	  and ( ( $d->{owner} == $this and $d->{isa}{$role} == 1 )
 		or $this->_Validate() );
 
+	# if there were no descriptor in cache we need to ensure that the cache
+	# chain is valid before reolving starts
+	$this->_Validate() unless $d;
+
 	# the cache chain is valid
 	# $d is not a valid descriptor
 
@@ -127,7 +140,7 @@
 	return [
 		map $_->{value},
 		grep $_->{isa}{$role},
-		map $_->{$_entries},
+		map @{$_->{$_entries}},
 		@{ $this->{$_parents} || [] },
 		$this
 	];
@@ -137,7 +150,7 @@
 sub Register {
 	my ( $this, $isa, $value ) = @_;
 
-	$isa = { $isa, 1 } unless isHash($isa);
+	$isa = { $isa, 1 } unless ishash($isa);
 
 	push @{ $this->{$_entries} },
 	  { owner => $this, isa => $isa, value => $value };