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 |