package IMPL::Config::Bag;
use strict;

use IMPL::lang qw(:base);
use IMPL::declare {
	base => [
		'IMPL::Object' => undef
	],
	props => [
		_parents   => '*rw',    # array of parent bags
		_state     => '*rw',    #array of previous timestamps
		_cache     => '*rw',    # own or cached entries
		_timestamp => '*rw',
		_entries   => '*rw',    # each entry is represented by hash
		  # { isa => linear_isa_hash, owner => owner_of_the_entry, value => value }
	]
};

sub CTOR {
	my ( $this, $p ) = @_;

	if ($p) {
		my @parents;
		push @parents, @{ $p->{$_parents} } if $p->{$_parents};
		push @parents, $p;
		$this->{$_parents} = \@parents;
		$this->{$_state} = [ map $_->{$_timestamp}, @parents ];
	}

	$this->{$_timestamp} = 0;
	$this->{$_cache}     = {};
	$this->{$_entries}   = [];
}

sub GetParent {
	$_[0]->{$_parents} && $_[0]->{$_parents}[0];
}

sub _Validate {
	my ($this) = @_;

	my $parents = $this->{$_parents}
	  or return;
	my $state = $this->{$_state};
	my $len   = @$parents;
	my $flush;

	for ( my $i = 0 ; $i < $len ; $i++ ) {
		if ($flush) {
			$parents->[$i]{$_cache} = {};
			$state->[$i] = $parents->[$i]{$_timestamp};
		}
		else {
			$flush = ( $parents->[$i]{$_timestamp} != $state->[$i] );
		}
	}

	if ($flush) {
		$this->{$_cache} = {};
		return 0;
	}

	return 1;
}

sub Resolve {
	my ( $this, $role ) = @_;

	if ( my $d = $this->GetDescriptor() ) {
		return $d->{value};
	}
	else {
		return;
	}
}

sub GetDescriptor {
	my ( $this, $role ) = @_;

	my $d = $this->{$_cache}{$role};

# return descriptor if this is own descriptor and its level is 1 (i.e. it can't be overriden by the parent cache)
# otherwise the cache must be validated
	return $d
	  if $d
	  and ( ( $d->{owner} == $this and $d->{isa}{$role} == 1 )
		or $this->_Validate() );

	# the cache chain is valid
	# $d is not a valid descriptor

	$d = undef;
	my $prev;

	if ( my $parents = $this->{$_parents} ) {
		foreach my $bag ( @$parents, $this ) {

			# check the cache;
			unless ( my $t = $bag->{$_cache}{$role} ) {

	  # no cached entry this may be due cache flush
	  # go through own entries and find better entry than inherited from parents
				foreach my $entry ( @{ $bag->{$_entries} } ) {
					my $level = $entry->{isa}{$role};
					if ( $level and ( not($prev) or $level <= $prev ) ) {
						$d    = $entry;
						$prev = $level;
					}
				}

				#cache it
				$bag->{$_cache}{$role} = $d if $d;
			}
			else {
				$d    = $t;
				$prev = $d->{isa}{$role};
			}
		}
	}

	return $d;
}

sub ResolveAll {
	my ( $this, $role ) = @_;

	return [
		map $_->{value},
		grep $_->{isa}{$role},
		map $_->{$_entries},
		@{ $this->{$_parents} || [] },
		$this
	];

}

sub Register {
	my ( $this, $isa, $value ) = @_;

	$isa = { $isa, 1 } unless isHash($isa);

	push @{ $this->{$_entries} },
	  { owner => $this, isa => $isa, value => $value };
	$this->{$_timestamp}++;

	delete $this->{$_cache}{$_} foreach keys %$isa;

	return $this;
}

1;