package IMPL::TypeKeyedCollection;
use strict;

use IMPL::Const qw(:prop);
use IMPL::lang;
use IMPL::declare {
	require => {
		ArgException => '-IMPL::InvalidArgumentException'
	},
	base => [
	   'IMPL::Object' => undef
	],
	props => [
	   _items => PROP_RW | PROP_DIRECT,
	   _cache => PROP_RW | PROP_DIRECT,
	   _reverse => PROP_RW | PROP_DIRECT
	]
};

sub CTOR {
	my ($this,$items,$reverse) = @_;
	
	$items = {}
	   unless ref($items) eq 'HASH';
	
	$this->{$_items} = $items;
	$this->{$_reverse} = $reverse;
}

sub Get {
	my ($this,$type) = @_;
	
	die ArgException->new(type => 'Invalid type', $type)
	   if not $type or ref($type);

    if(my $val = $this->{$_cache}{$type}) {
    	return $val;
    } else {
    	if ($this->_reverse) {
    		my $val = $this->{$_items}{$type};
    		
    		unless(defined $val) {
    			my $matching;
	    		while ( my ($k,$v) = each %{$this->{$_items}}) {
	    			if (isclass($k,$type) && (not($matching) || isclass($k,$matching)) ) {
	    				$matching =  $k;
	    				$val = $v;
	    			}
	    		}
    		}
    		
    		return $this->{$_cache}{$type} = $val;
    		
    	} else {
		    no strict 'refs';
		    	   
			my @isa = $type;
			
			while (@isa) {
				my $sclass = shift @isa;
	
				$val = $this->{$_items}{$sclass};
				
				return($this->{$_cache}{$type} = $val)
	                if defined $val; # zeroes and empty strings are also valid
	                
	            push @isa, @{"${sclass}::ISA"};
			}
			return;
    	}
    }
}

sub Set {
	my ($this,$type,$value) = @_;
	
	die ArgException->new(type => 'Invalid type', $type)
       if not $type or ref($type);
       
    $this->{$_items}{$type} = $value;   
    
    delete $this->{$_cache};
    
    return $value;
}

sub Delete {
	my ($this,$type) = @_;
	
	if(defined delete $this->{$_items}{$type} ) {
		delete $this->{$_cache};
		return 1;
	}
	return;
}

1;

__END__

=pod

=head1 NAME

C<IMPL::TypeKeyedCollection> - коллекция, ключами которой являются типы.

=head1 SYNOPSIS

=begin code

package Foo;

package Bar;
our @ISA = qw(Foo);

package Baz;
our @ISA = qw(Foo);

package main;
use IMPL::require {
	TypeKeyedCollection => 'IMPL::TypeKeyedCollection'
};

my $col = TypeKeyedCollection->new({
	Foo => 'base',
	Bar => 'BAAAR'
});

print $col->Get('Foo'); # 'base'
print $col->Get('Bar'); # 'BAAAR'
print $col->Get('Baz'); # 'base'

=end code

=head1 DESCRIPTION

Использует иерархию классов для определения наиболее подходяжего значения в
коллекции.

=cut