Mercurial > pub > Impl
comparison Lib/IMPL/TypeKeyedCollection.pm @ 316:608beb8b3c6c
added type keyed collection
| author | sergey |
|---|---|
| date | Wed, 08 May 2013 16:19:34 +0400 |
| parents | |
| children | 96a522aeb359 |
comparison
equal
deleted
inserted
replaced
| 315:77df11605d3a | 316:608beb8b3c6c |
|---|---|
| 1 package IMPL::TypeKeyedCollection; | |
| 2 use strict; | |
| 3 | |
| 4 use IMPL::Const qw(:prop); | |
| 5 use IMPL::declare { | |
| 6 require => { | |
| 7 ArgException => '-IMPL::InvalidArgumentException' | |
| 8 }, | |
| 9 base => [ | |
| 10 'IMPL::Object' => undef | |
| 11 ], | |
| 12 props => [ | |
| 13 _items => PROP_RW | PROP_DIRECT, | |
| 14 _cache => PROP_RW | PROP_DIRECT | |
| 15 ] | |
| 16 }; | |
| 17 | |
| 18 sub CTOR { | |
| 19 my ($this,$items) = @_; | |
| 20 | |
| 21 $items = {} | |
| 22 unless ref($items) eq 'HASH'; | |
| 23 | |
| 24 $this->{$_items} = $items; | |
| 25 } | |
| 26 | |
| 27 sub Get { | |
| 28 my ($this,$type) = @_; | |
| 29 | |
| 30 die ArgException->(type => 'Invalid type', $type) | |
| 31 if ref($type); | |
| 32 | |
| 33 if(my $val = $this->{$_cache}{$type}) { | |
| 34 return $val; | |
| 35 } else { | |
| 36 no strict 'refs'; | |
| 37 | |
| 38 my @isa = $type; | |
| 39 | |
| 40 while (@isa) { | |
| 41 my $sclass = shift @isa; | |
| 42 | |
| 43 $val = $this->{$_items}{$sclass}; | |
| 44 | |
| 45 return $this->{$_cache}{$type} = $val | |
| 46 if defined $val; # zeroes and empty strings are also valid | |
| 47 | |
| 48 push @isa, @{"${sclass}::ISA"}; | |
| 49 } | |
| 50 return; | |
| 51 } | |
| 52 } | |
| 53 | |
| 54 sub Set { | |
| 55 my ($this,$type,$value) = @_; | |
| 56 | |
| 57 die ArgException->(type => 'Invalid type', $type) | |
| 58 if ref($type); | |
| 59 | |
| 60 $this->{$_items}{$type} = $value; | |
| 61 | |
| 62 delete $this->{$_cache}; | |
| 63 | |
| 64 return $value; | |
| 65 } | |
| 66 | |
| 67 sub Delete { | |
| 68 my ($this,$type) = @_; | |
| 69 | |
| 70 if(defined delete $this->{$_items}{$type} ) { | |
| 71 delete $this->{$_cache}; | |
| 72 return 1; | |
| 73 } | |
| 74 return; | |
| 75 } | |
| 76 | |
| 77 1; | |
| 78 | |
| 79 __END__ | |
| 80 | |
| 81 =pod | |
| 82 | |
| 83 =head1 NAME | |
| 84 | |
| 85 C<IMPL::TypeKeyedCollection> - коллекция, ключами которой являются типы. | |
| 86 | |
| 87 =head1 SYNOPSIS | |
| 88 | |
| 89 =begin code | |
| 90 | |
| 91 package Foo; | |
| 92 | |
| 93 package Bar; | |
| 94 our @ISA = qw(Foo); | |
| 95 | |
| 96 package Baz; | |
| 97 our @ISA = qw(Foo); | |
| 98 | |
| 99 package main; | |
| 100 use IMPL::require { | |
| 101 TypeKeyedCollection => 'IMPL::TypeKeyedCollection' | |
| 102 }; | |
| 103 | |
| 104 my $col = TypeKeyedCollection->new({ | |
| 105 Foo => 'base', | |
| 106 Bar => 'BAAAR' | |
| 107 }); | |
| 108 | |
| 109 print $col->Get('Foo'); # 'base' | |
| 110 print $col->Get('Bar'); # 'BAAAR' | |
| 111 print $col->Get('Baz'); # 'base' | |
| 112 | |
| 113 =end code | |
| 114 | |
| 115 =head1 DESCRIPTION | |
| 116 | |
| 117 Использует иерархию классов для определения наиболее подходяжего значения в | |
| 118 коллекции. | |
| 119 | |
| 120 =cut |
