|
316
|
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
|
|
317
|
30 die ArgException->new(type => 'Invalid type', $type)
|
|
|
31 if not $type or ref($type);
|
|
316
|
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
|
|
317
|
45 return($this->{$_cache}{$type} = $val)
|
|
316
|
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
|
|
317
|
57 die ArgException->new(type => 'Invalid type', $type)
|
|
|
58 if not $type or ref($type);
|
|
316
|
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 |
