--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/TypeKeyedCollection.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,140 @@
+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
\ No newline at end of file