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