# HG changeset patch
# User sergey
# Date 1368015574 -14400
# Node ID 608beb8b3c6c1bf02ea4a9ad1552ac38226f960f
# Parent  77df11605d3ae569b8af46bd880f6a24b64d852e
added type keyed collection

diff -r 77df11605d3a -r 608beb8b3c6c Lib/IMPL/TypeKeyedCollection.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/TypeKeyedCollection.pm	Wed May 08 16:19:34 2013 +0400
@@ -0,0 +1,120 @@
+package IMPL::TypeKeyedCollection;
+use strict;
+
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+	require => {
+		ArgException => '-IMPL::InvalidArgumentException'
+	},
+	base => [
+	   'IMPL::Object' => undef
+	],
+	props => [
+	   _items => PROP_RW | PROP_DIRECT,
+	   _cache => PROP_RW | PROP_DIRECT
+	]
+};
+
+sub CTOR {
+	my ($this,$items) = @_;
+	
+	$items = {}
+	   unless ref($items) eq 'HASH';
+	
+	$this->{$_items} = $items;
+}
+
+sub Get {
+	my ($this,$type) = @_;
+	
+	die ArgException->(type => 'Invalid type', $type)
+	   if ref($type);
+
+    if(my $val = $this->{$_cache}{$type}) {
+    	return $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->(type => 'Invalid type', $type)
+       if 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