Mercurial > pub > Impl
diff Lib/IMPL/TypeKeyedCollection.pm @ 316:608beb8b3c6c
added type keyed collection
author | sergey |
---|---|
date | Wed, 08 May 2013 16:19:34 +0400 |
parents | |
children | 96a522aeb359 |
line wrap: on
line diff
--- /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